From 53d5b59cb3b417ab8293702aacc75a9bbb3ead78 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 16 Aug 2021 09:26:26 +0200 Subject: [PATCH] Fortran/OpenMP: Add support for OpenMP 5.1 masked construct Commit r12-2891-gd0befed793b94f3f407be44e6f69f81a02f5f073 added C/C++ support for the masked construct. This patch extends it to Fortran. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause. (show_omp_node, show_code_node): Handle (combined) omp masked construct. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*. (enum gfc_exec_op): Add EXEC_OMP_*_MASKED*. * match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd): New prototypes. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER. (gfc_match_omp_clauses): Match it. (OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd, gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd): New. (resolve_omp_clauses): Resolve filter clause. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp masked constructs. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause. (GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values. (gfc_trans_omp_masked): New. (gfc_split_omp_clauses): Handle combined masked directives. (gfc_trans_omp_master_taskloop): Rename to ... (gfc_trans_omp_master_masked_taskloop): ... this; handle also combined masked directives. (gfc_trans_omp_parallel_master): Rename to ... (gfc_trans_omp_parallel_master_masked): ... this; handle combined masked directives. (gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/masked-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/masked-1.f90: New test. * gfortran.dg/gomp/masked-2.f90: New test. * gfortran.dg/gomp/masked-3.f90: New test. * gfortran.dg/gomp/masked-combined-1.f90: New test. * gfortran.dg/gomp/masked-combined-2.f90: New test. --- gcc/fortran/dump-parse-tree.c | 24 +++ gcc/fortran/frontend-passes.c | 3 + gcc/fortran/gfortran.h | 14 +- gcc/fortran/match.h | 6 + gcc/fortran/openmp.c | 98 ++++++++++++ gcc/fortran/parse.c | 91 ++++++++++- gcc/fortran/resolve.c | 15 ++ gcc/fortran/st.c | 6 + gcc/fortran/trans-openmp.c | 176 +++++++++++++++++---- gcc/fortran/trans.c | 6 + gcc/testsuite/gfortran.dg/gomp/masked-1.f90 | 94 +++++++++++ gcc/testsuite/gfortran.dg/gomp/masked-2.f90 | 46 ++++++ gcc/testsuite/gfortran.dg/gomp/masked-3.f90 | 12 ++ .../gfortran.dg/gomp/masked-combined-1.f90 | 65 ++++++++ .../gfortran.dg/gomp/masked-combined-2.f90 | 24 +++ libgomp/testsuite/libgomp.fortran/masked-1.f90 | 119 ++++++++++++++ 16 files changed, 766 insertions(+), 33 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/masked-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/masked-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/masked-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/masked-combined-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/masked-combined-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/masked-1.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 360abf1..53c49fe 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1808,6 +1808,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->grainsize); fputc (')', dumpfile); } + if (omp_clauses->filter) + { + fputs (" FILTER(", dumpfile); + show_expr (omp_clauses->filter); + fputc (')', dumpfile); + } if (omp_clauses->hint) { fputs (" HINT(", dumpfile); @@ -1946,6 +1952,9 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break; case EXEC_OMP_LOOP: name = "LOOP"; break; case EXEC_OMP_FLUSH: name = "FLUSH"; break; + case EXEC_OMP_MASKED: name = "MASKED"; break; + case EXEC_OMP_MASKED_TASKLOOP: name = "MASKED TASKLOOP"; break; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: name = "MASKED TASKLOOP SIMD"; break; case EXEC_OMP_MASTER: name = "MASTER"; break; case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break; case EXEC_OMP_MASTER_TASKLOOP_SIMD: name = "MASTER TASKLOOP SIMD"; break; @@ -1956,6 +1965,11 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break; case EXEC_OMP_PARALLEL_LOOP: name = "PARALLEL LOOP"; break; case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break; + case EXEC_OMP_PARALLEL_MASKED: name = "PARALLEL MASK"; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + name = "PARALLEL MASK TASKLOOP"; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + name = "PARALLEL MASK TASKLOOP SIMD"; break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: name = "PARALLEL MASTER TASKLOOP"; break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -2032,10 +2046,14 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_DO_SIMD: case EXEC_OMP_LOOP: case EXEC_OMP_ORDERED: + case EXEC_OMP_MASKED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -3250,6 +3268,9 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_DO_SIMD: case EXEC_OMP_FLUSH: case EXEC_OMP_LOOP: + case EXEC_OMP_MASKED: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -3258,6 +3279,9 @@ show_code_node (int level, gfc_code *c) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 996dcc2..145bff5 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -5556,6 +5556,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8f75dd9..5fde417 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -275,7 +275,13 @@ enum gfc_statement ST_OMP_PARALLEL_LOOP, ST_OMP_END_PARALLEL_LOOP, ST_OMP_TEAMS_LOOP, ST_OMP_END_TEAMS_LOOP, ST_OMP_TARGET_PARALLEL_LOOP, ST_OMP_END_TARGET_PARALLEL_LOOP, ST_OMP_TARGET_TEAMS_LOOP, - ST_OMP_END_TARGET_TEAMS_LOOP, ST_NONE + ST_OMP_END_TARGET_TEAMS_LOOP, ST_OMP_MASKED, ST_OMP_END_MASKED, + ST_OMP_PARALLEL_MASKED, ST_OMP_END_PARALLEL_MASKED, + ST_OMP_PARALLEL_MASKED_TASKLOOP, ST_OMP_END_PARALLEL_MASKED_TASKLOOP, + ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD, + ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP, + ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD, + ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_NONE }; /* Types of interfaces that we can have. Assignment interfaces are @@ -1466,6 +1472,7 @@ typedef struct gfc_omp_clauses struct gfc_expr *device; struct gfc_expr *thread_limit; struct gfc_expr *grainsize; + struct gfc_expr *filter; struct gfc_expr *hint; struct gfc_expr *num_tasks; struct gfc_expr *priority; @@ -2758,7 +2765,10 @@ enum gfc_exec_op EXEC_OMP_PARALLEL_MASTER, EXEC_OMP_PARALLEL_MASTER_TASKLOOP, EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, EXEC_OMP_MASTER_TASKLOOP, EXEC_OMP_MASTER_TASKLOOP_SIMD, EXEC_OMP_LOOP, EXEC_OMP_PARALLEL_LOOP, - EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP, EXEC_OMP_TARGET_TEAMS_LOOP + EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP, + EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED, + EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD, + EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD }; typedef struct gfc_code diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index bb1f34f..dce6503 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -169,6 +169,9 @@ match gfc_match_omp_do (void); match gfc_match_omp_do_simd (void); match gfc_match_omp_loop (void); match gfc_match_omp_flush (void); +match gfc_match_omp_masked (void); +match gfc_match_omp_masked_taskloop (void); +match gfc_match_omp_masked_taskloop_simd (void); match gfc_match_omp_master (void); match gfc_match_omp_master_taskloop (void); match gfc_match_omp_master_taskloop_simd (void); @@ -178,6 +181,9 @@ match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); match gfc_match_omp_parallel_do_simd (void); match gfc_match_omp_parallel_loop (void); +match gfc_match_omp_parallel_masked (void); +match gfc_match_omp_parallel_masked_taskloop (void); +match gfc_match_omp_parallel_masked_taskloop_simd (void); match gfc_match_omp_parallel_master (void); match gfc_match_omp_parallel_master_taskloop (void); match gfc_match_omp_parallel_master_taskloop_simd (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index ec55865..1bce43c 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -847,6 +847,7 @@ enum omp_mask1 OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ OMP_CLAUSE_BIND, /* OpenMP 5.0. */ + OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -1772,6 +1773,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'f': + if ((mask & OMP_CLAUSE_FILTER) + && c->filter == NULL + && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) @@ -3199,6 +3204,8 @@ cleanup: #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER) +#define OMP_MASKED_CLAUSES \ + (omp_mask (OMP_CLAUSE_FILTER)) static match @@ -4158,6 +4165,31 @@ gfc_match_omp_parallel_do_simd (void) match +gfc_match_omp_parallel_masked (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASKED, + OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES); +} + +match +gfc_match_omp_parallel_masked_taskloop (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP, + (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES + | OMP_TASKLOOP_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION))); +} + +match +gfc_match_omp_parallel_masked_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD, + (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES + | OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION))); +} + +match gfc_match_omp_parallel_master (void) { return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES); @@ -4704,6 +4736,27 @@ gfc_match_omp_workshare (void) match +gfc_match_omp_masked (void) +{ + return match_omp (EXEC_OMP_MASKED, OMP_MASKED_CLAUSES); +} + +match +gfc_match_omp_masked_taskloop (void) +{ + return match_omp (EXEC_OMP_MASKED_TASKLOOP, + OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES); +} + +match +gfc_match_omp_masked_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_MASKED_TASKLOOP_SIMD, + (OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES + | OMP_SIMD_CLAUSES)); +} + +match gfc_match_omp_master (void) { if (gfc_match_omp_eos () != MATCH_YES) @@ -5254,6 +5307,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_MASKED: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: @@ -5268,10 +5322,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: ok = (ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP @@ -5290,11 +5346,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, break; case EXEC_OMP_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP: ok = ifc == OMP_IF_TASKLOOP; break; case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP_SIMD: ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD; break; @@ -6060,9 +6118,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && (code->op == EXEC_OMP_LOOP || code->op == EXEC_OMP_TASKLOOP || code->op == EXEC_OMP_TASKLOOP_SIMD + || code->op == EXEC_OMP_MASKED_TASKLOOP + || code->op == EXEC_OMP_MASKED_TASKLOOP_SIMD || code->op == EXEC_OMP_MASTER_TASKLOOP || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD || code->op == EXEC_OMP_PARALLEL_LOOP + || code->op == EXEC_OMP_PARALLEL_MASKED_TASKLOOP + || code->op == EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD || code->op == EXEC_OMP_TARGET_PARALLEL_LOOP @@ -6322,6 +6384,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); if (omp_clauses->device) resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); + if (omp_clauses->filter) + resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER"); if (omp_clauses->hint) { resolve_scalar_int_expr (omp_clauses->hint, "HINT"); @@ -6984,8 +7048,12 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_TARGET_PARALLEL_DO: @@ -7133,6 +7201,13 @@ resolve_omp_do (gfc_code *code) is_simd = true; break; case EXEC_OMP_PARALLEL_LOOP: name = "!$OMP PARALLEL LOOP"; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + name = "!$OMP PARALLEL MASKED TASKLOOP"; + break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + name = "!$OMP PARALLEL MASKED TASKLOOP SIMD"; + is_simd = true; + break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: name = "!$OMP PARALLEL MASTER TASKLOOP"; break; @@ -7140,6 +7215,11 @@ resolve_omp_do (gfc_code *code) name = "!$OMP PARALLEL MASTER TASKLOOP SIMD"; is_simd = true; break; + case EXEC_OMP_MASKED_TASKLOOP: name = "!$OMP MASKED TASKLOOP"; break; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + name = "!$OMP MASKED TASKLOOP SIMD"; + is_simd = true; + break; case EXEC_OMP_MASTER_TASKLOOP: name = "!$OMP MASTER TASKLOOP"; break; case EXEC_OMP_MASTER_TASKLOOP_SIMD: name = "!$OMP MASTER TASKLOOP SIMD"; @@ -7302,6 +7382,12 @@ omp_code_to_statement (gfc_code *code) { case EXEC_OMP_PARALLEL: return ST_OMP_PARALLEL; + case EXEC_OMP_PARALLEL_MASKED: + return ST_OMP_PARALLEL_MASKED; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + return ST_OMP_PARALLEL_MASKED_TASKLOOP; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + return ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD; case EXEC_OMP_PARALLEL_MASTER: return ST_OMP_PARALLEL_MASTER; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: @@ -7316,6 +7402,12 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_ORDERED; case EXEC_OMP_CRITICAL: return ST_OMP_CRITICAL; + case EXEC_OMP_MASKED: + return ST_OMP_MASKED; + case EXEC_OMP_MASKED_TASKLOOP: + return ST_OMP_MASKED_TASKLOOP; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + return ST_OMP_MASKED_TASKLOOP_SIMD; case EXEC_OMP_MASTER: return ST_OMP_MASTER; case EXEC_OMP_MASTER_TASKLOOP: @@ -7822,8 +7914,12 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_SIMD: @@ -7846,8 +7942,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) resolve_omp_do (code); break; case EXEC_OMP_CANCEL: + case EXEC_OMP_MASKED: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_MASKED: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 6d7845e..e1d78de 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -920,6 +920,11 @@ decode_omp_directive (void) matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD); + matcho ("end masked taskloop simd", gfc_match_omp_eos_error, + ST_OMP_END_MASKED_TASKLOOP_SIMD); + matcho ("end masked taskloop", gfc_match_omp_eos_error, + ST_OMP_END_MASKED_TASKLOOP); + matcho ("end masked", gfc_match_omp_eos_error, ST_OMP_END_MASKED); matcho ("end master taskloop simd", gfc_match_omp_eos_error, ST_OMP_END_MASTER_TASKLOOP_SIMD); matcho ("end master taskloop", gfc_match_omp_eos_error, @@ -929,6 +934,12 @@ decode_omp_directive (void) matchs ("end parallel do simd", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO_SIMD); matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO); + matcho ("end parallel masked taskloop simd", gfc_match_omp_eos_error, + ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD); + matcho ("end parallel masked taskloop", gfc_match_omp_eos_error, + ST_OMP_END_PARALLEL_MASKED_TASKLOOP); + matcho ("end parallel masked", gfc_match_omp_eos_error, + ST_OMP_END_PARALLEL_MASKED); matcho ("end parallel master taskloop simd", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD); matcho ("end parallel master taskloop", gfc_match_omp_eos_error, @@ -982,6 +993,11 @@ decode_omp_directive (void) matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); break; case 'm': + matcho ("masked taskloop simd", gfc_match_omp_masked_taskloop_simd, + ST_OMP_MASKED_TASKLOOP_SIMD); + matcho ("masked taskloop", gfc_match_omp_masked_taskloop, + ST_OMP_MASKED_TASKLOOP); + matcho ("masked", gfc_match_omp_masked, ST_OMP_MASKED); matcho ("master taskloop simd", gfc_match_omp_master_taskloop_simd, ST_OMP_MASTER_TASKLOOP_SIMD); matcho ("master taskloop", gfc_match_omp_master_taskloop, @@ -1009,6 +1025,14 @@ decode_omp_directive (void) matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO); matcho ("parallel loop", gfc_match_omp_parallel_loop, ST_OMP_PARALLEL_LOOP); + matcho ("parallel masked taskloop simd", + gfc_match_omp_parallel_masked_taskloop_simd, + ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD); + matcho ("parallel masked taskloop", + gfc_match_omp_parallel_masked_taskloop, + ST_OMP_PARALLEL_MASKED_TASKLOOP); + matcho ("parallel masked", gfc_match_omp_parallel_masked, + ST_OMP_PARALLEL_MASKED); matcho ("parallel master taskloop simd", gfc_match_omp_parallel_master_taskloop_simd, ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD); @@ -1639,11 +1663,15 @@ next_statement (void) #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \ case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \ case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \ - case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASTER: \ + case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: \ + case ST_OMP_PARALLEL_MASKED_TASKLOOP: \ + case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER: \ case ST_OMP_PARALLEL_MASTER_TASKLOOP: \ case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: \ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ - case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \ + case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP: \ + case ST_OMP_MASKED_TASKLOOP_SIMD: \ + case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \ case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ @@ -2376,6 +2404,15 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_LOOP: p = "!$OMP END LOOP"; break; + case ST_OMP_END_MASKED: + p = "!$OMP END MASKED"; + break; + case ST_OMP_END_MASKED_TASKLOOP: + p = "!$OMP END MASKED TASKLOOP"; + break; + case ST_OMP_END_MASKED_TASKLOOP_SIMD: + p = "!$OMP END MASKED TASKLOOP SIMD"; + break; case ST_OMP_END_MASTER: p = "!$OMP END MASTER"; break; @@ -2400,6 +2437,15 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_PARALLEL_LOOP: p = "!$OMP END PARALLEL LOOP"; break; + case ST_OMP_END_PARALLEL_MASKED: + p = "!$OMP END PARALLEL MASKED"; + break; + case ST_OMP_END_PARALLEL_MASKED_TASKLOOP: + p = "!$OMP END PARALLEL MASKED TASKLOOP"; + break; + case ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD: + p = "!$OMP END PARALLEL MASKED TASKLOOP SIMD"; + break; case ST_OMP_END_PARALLEL_MASTER: p = "!$OMP END PARALLEL MASTER"; break; @@ -2499,6 +2545,15 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_LOOP: p = "!$OMP LOOP"; break; + case ST_OMP_MASKED: + p = "!$OMP MASKED"; + break; + case ST_OMP_MASKED_TASKLOOP: + p = "!$OMP MASKED TASKLOOP"; + break; + case ST_OMP_MASKED_TASKLOOP_SIMD: + p = "!$OMP MASKED TASKLOOP SIMD"; + break; case ST_OMP_MASTER: p = "!$OMP MASTER"; break; @@ -2524,6 +2579,15 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_PARALLEL_DO_SIMD: p = "!$OMP PARALLEL DO SIMD"; break; + case ST_OMP_PARALLEL_MASKED: + p = "!$OMP PARALLEL MASKED"; + break; + case ST_OMP_PARALLEL_MASKED_TASKLOOP: + p = "!$OMP PARALLEL MASKED TASKLOOP"; + break; + case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + p = "!$OMP PARALLEL MASKED TASKLOOP SIMD"; + break; case ST_OMP_PARALLEL_MASTER: p = "!$OMP PARALLEL MASTER"; break; @@ -5127,10 +5191,20 @@ parse_omp_do (gfc_statement omp_st) break; case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break; case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break; + case ST_OMP_MASKED_TASKLOOP: omp_end_st = ST_OMP_END_MASKED_TASKLOOP; break; + case ST_OMP_MASKED_TASKLOOP_SIMD: + omp_end_st = ST_OMP_END_MASKED_TASKLOOP_SIMD; + break; case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break; case ST_OMP_MASTER_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD; break; + case ST_OMP_PARALLEL_MASKED_TASKLOOP: + omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP; + break; + case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD; + break; case ST_OMP_PARALLEL_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP; break; @@ -5380,6 +5454,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_PARALLEL: omp_end_st = ST_OMP_END_PARALLEL; break; + case ST_OMP_PARALLEL_MASKED: + omp_end_st = ST_OMP_END_PARALLEL_MASKED; + break; case ST_OMP_PARALLEL_MASTER: omp_end_st = ST_OMP_END_PARALLEL_MASTER; break; @@ -5395,6 +5472,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_CRITICAL: omp_end_st = ST_OMP_END_CRITICAL; break; + case ST_OMP_MASKED: + omp_end_st = ST_OMP_END_MASKED; + break; case ST_OMP_MASTER: omp_end_st = ST_OMP_END_MASTER; break; @@ -5477,6 +5557,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) break; case ST_OMP_PARALLEL: + case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: case ST_OMP_PARALLEL_SECTIONS: parse_omp_structured_block (st, false); @@ -5679,11 +5760,13 @@ parse_executable (gfc_statement st) break; case ST_OMP_PARALLEL: + case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: case ST_OMP_CRITICAL: + case ST_OMP_MASKED: case ST_OMP_MASTER: case ST_OMP_SINGLE: case ST_OMP_TARGET: @@ -5711,8 +5794,12 @@ parse_executable (gfc_statement st) case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_PARALLEL_LOOP: + case ST_OMP_PARALLEL_MASKED_TASKLOOP: + case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER_TASKLOOP: case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + case ST_OMP_MASKED_TASKLOOP: + case ST_OMP_MASKED_TASKLOOP_SIMD: case ST_OMP_MASTER_TASKLOOP: case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SIMD: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 959f0be..8eb8a9a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10818,6 +10818,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_LOOP: + case EXEC_OMP_MASKED: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -10826,6 +10829,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -11793,6 +11799,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: @@ -12248,6 +12257,9 @@ start: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASKED: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: case EXEC_OMP_SCAN: case EXEC_OMP_SECTIONS: @@ -12289,6 +12301,9 @@ start: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 6ae1df6..f61f88a 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -227,13 +227,19 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_DO_SIMD: case EXEC_OMP_LOOP: case EXEC_OMP_END_SINGLE: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_ORDERED: + case EXEC_OMP_MASKED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 3d3b35e..623c21f 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4047,6 +4047,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->filter) + { + tree filter; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->filter); + gfc_add_block_to_block (block, &se.pre); + filter = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FILTER); + OMP_CLAUSE_FILTER_EXPR (c) = filter; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->hint) { tree hint; @@ -5390,6 +5405,26 @@ gfc_trans_omp_master (gfc_code *code) } static tree +gfc_trans_omp_masked (gfc_code *code, gfc_omp_clauses *clauses) +{ + stmtblock_t block; + tree body = gfc_trans_code (code->block->next); + if (IS_EMPTY_STMT (body)) + return body; + if (!clauses) + clauses = code->ext.omp_clauses; + gfc_start_block (&block); + tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc); + tree stmt = make_node (OMP_MASKED); + TREE_TYPE (stmt) = void_type_node; + OMP_MASKED_BODY (stmt) = body; + OMP_MASKED_CLAUSES (stmt) = omp_clauses; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + + +static tree gfc_trans_omp_ordered (gfc_code *code) { if (!flag_openmp) @@ -5432,6 +5467,7 @@ enum GFC_OMP_SPLIT_TEAMS, GFC_OMP_SPLIT_TARGET, GFC_OMP_SPLIT_TASKLOOP, + GFC_OMP_SPLIT_MASKED, GFC_OMP_SPLIT_NUM }; @@ -5443,7 +5479,8 @@ enum GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET), - GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP) + GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP), + GFC_OMP_MASK_MASKED = (1 << GFC_OMP_SPLIT_MASKED) }; /* If a var is in lastprivate/firstprivate/reduction but not in a @@ -5632,10 +5669,24 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_PARALLEL_MASKED: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED; + innermost = GFC_OMP_SPLIT_MASKED; + break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED + | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD); + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_TASKLOOP; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED + | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD); + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; @@ -5692,10 +5743,18 @@ gfc_split_omp_clauses (gfc_code *code, mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO; innermost = GFC_OMP_SPLIT_DO; break; + case EXEC_OMP_MASKED_TASKLOOP: + mask = GFC_OMP_SPLIT_MASKED | GFC_OMP_SPLIT_TASKLOOP; + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_TASKLOOP: innermost = GFC_OMP_SPLIT_TASKLOOP; break; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + mask = GFC_OMP_MASK_MASKED | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_TASKLOOP_SIMD: mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; @@ -5814,6 +5873,8 @@ 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_MASKED) + clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter; if ((mask & GFC_OMP_MASK_DO) && !is_loop) { /* First the clauses that are unique to some constructs. */ @@ -5896,16 +5957,18 @@ gfc_split_omp_clauses (gfc_code *code, clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse = code->ext.omp_clauses->collapse; } - /* Private clause is supported on all constructs, - it is enough to put it on the innermost one. For + /* Private clause is supported on all constructs but master/masked, + it is enough to put it on the innermost one except for master/masked. 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 && !is_loop + clausesa[((innermost == GFC_OMP_SPLIT_DO && !is_loop) + || code->op == EXEC_OMP_PARALLEL_MASTER + || code->op == EXEC_OMP_PARALLEL_MASKED) ? (int) GFC_OMP_SPLIT_PARALLEL : innermost].lists[OMP_LIST_PRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; /* Firstprivate clause is supported on all constructs but - simd. Put it on the outermost of those and duplicate + simd and masked/master. Put it on the outermost of those and duplicate on parallel and teams. */ if (mask & GFC_OMP_MASK_TARGET) clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE] @@ -6588,43 +6651,66 @@ gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op) } static tree -gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op) +gfc_trans_omp_master_masked_taskloop (gfc_code *code, gfc_exec_op op) { + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; stmtblock_t block; tree stmt; - gfc_start_block (&block); + if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD + && code->op != EXEC_OMP_MASTER_TASKLOOP) + gfc_split_omp_clauses (code, clausesa); + pushlevel (); - if (op == EXEC_OMP_MASTER_TASKLOOP_SIMD) + if (op == EXEC_OMP_MASKED_TASKLOOP_SIMD + || op == EXEC_OMP_MASTER_TASKLOOP_SIMD) stmt = gfc_trans_omp_taskloop (code, EXEC_OMP_TASKLOOP_SIMD); else { - gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; - gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP); - if (op != code->op) - gfc_split_omp_clauses (code, clausesa); + gcc_assert (op == EXEC_OMP_MASKED_TASKLOOP + || op == EXEC_OMP_MASTER_TASKLOOP); stmt = gfc_trans_omp_do (code, EXEC_OMP_TASKLOOP, NULL, - op != code->op + code->op != EXEC_OMP_MASTER_TASKLOOP ? &clausesa[GFC_OMP_SPLIT_TASKLOOP] : code->ext.omp_clauses, NULL); - if (op != code->op) - gfc_free_split_omp_clauses (code, clausesa); } if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else poplevel (0, 0); - stmt = build1_v (OMP_MASTER, stmt); - gfc_add_expr_to_block (&block, stmt); + gfc_start_block (&block); + if (op == EXEC_OMP_MASKED_TASKLOOP || op == EXEC_OMP_MASKED_TASKLOOP_SIMD) + { + tree clauses = gfc_trans_omp_clauses (&block, + &clausesa[GFC_OMP_SPLIT_MASKED], + code->loc); + tree msk = make_node (OMP_MASKED); + TREE_TYPE (msk) = void_type_node; + OMP_MASKED_BODY (msk) = stmt; + OMP_MASKED_CLAUSES (msk) = clauses; + OMP_MASKED_COMBINED (msk) = 1; + gfc_add_expr_to_block (&block, msk); + } + else + { + gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP + || op == EXEC_OMP_MASTER_TASKLOOP_SIMD); + stmt = build1_v (OMP_MASTER, stmt); + gfc_add_expr_to_block (&block, stmt); + } + if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD + && code->op != EXEC_OMP_MASTER_TASKLOOP) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } static tree -gfc_trans_omp_parallel_master (gfc_code *code) +gfc_trans_omp_parallel_master_masked (gfc_code *code) { stmtblock_t block; tree stmt, omp_clauses; gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + bool parallel_combined = false; if (code->op != EXEC_OMP_PARALLEL_MASTER) gfc_split_omp_clauses (code, clausesa); @@ -6635,19 +6721,33 @@ gfc_trans_omp_parallel_master (gfc_code *code) ? code->ext.omp_clauses : &clausesa[GFC_OMP_SPLIT_PARALLEL], code->loc); - if (code->op != EXEC_OMP_PARALLEL_MASTER) - gfc_free_split_omp_clauses (code, clausesa); pushlevel (); if (code->op == EXEC_OMP_PARALLEL_MASTER) stmt = gfc_trans_omp_master (code); + else if (code->op == EXEC_OMP_PARALLEL_MASKED) + stmt = gfc_trans_omp_masked (code, &clausesa[GFC_OMP_SPLIT_MASKED]); else { - gcc_assert (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP - || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD); - gfc_exec_op op = (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP - ? EXEC_OMP_MASTER_TASKLOOP - : EXEC_OMP_MASTER_TASKLOOP_SIMD); - stmt = gfc_trans_omp_master_taskloop (code, op); + gfc_exec_op op; + switch (code->op) + { + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + op = EXEC_OMP_MASKED_TASKLOOP; + break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + op = EXEC_OMP_MASKED_TASKLOOP_SIMD; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + op = EXEC_OMP_MASTER_TASKLOOP; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + op = EXEC_OMP_MASTER_TASKLOOP_SIMD; + break; + default: + gcc_unreachable (); + } + stmt = gfc_trans_omp_master_masked_taskloop (code, op); + parallel_combined = true; } if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); @@ -6655,8 +6755,19 @@ gfc_trans_omp_parallel_master (gfc_code *code) poplevel (0, 0); stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL, void_type_node, stmt, omp_clauses); - OMP_PARALLEL_COMBINED (stmt) = 1; + /* masked does have just filter clause, but during gimplification + isn't represented by a gimplification omp context, so for + !$omp parallel masked don't set OMP_PARALLEL_COMBINED, + so that + !$omp parallel masked + !$omp taskloop simd lastprivate (x) + isn't confused with + !$omp parallel masked taskloop simd lastprivate (x) */ + if (parallel_combined) + OMP_PARALLEL_COMBINED (stmt) = 1; gfc_add_expr_to_block (&block, stmt); + if (code->op != EXEC_OMP_PARALLEL_MASTER) + gfc_free_split_omp_clauses (code, clausesa); return gfc_finish_block (&block); } @@ -6969,11 +7080,15 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (code); + case EXEC_OMP_MASKED: + return gfc_trans_omp_masked (code, NULL); case EXEC_OMP_MASTER: return gfc_trans_omp_master (code); + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: - return gfc_trans_omp_master_taskloop (code, code->op); + return gfc_trans_omp_master_masked_taskloop (code, code->op); case EXEC_OMP_ORDERED: return gfc_trans_omp_ordered (code); case EXEC_OMP_PARALLEL: @@ -6984,10 +7099,13 @@ gfc_trans_omp_directive (gfc_code *code) 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_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: - return gfc_trans_omp_parallel_master (code); + return gfc_trans_omp_parallel_master_masked (code); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 275d6a2..ce5b2f8 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2156,6 +2156,9 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_DO_SIMD: case EXEC_OMP_LOOP: case EXEC_OMP_FLUSH: + case EXEC_OMP_MASKED: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_MASTER_TASKLOOP: case EXEC_OMP_MASTER_TASKLOOP_SIMD: @@ -2164,6 +2167,9 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 new file mode 100644 index 0000000..1bd6176 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 @@ -0,0 +1,94 @@ +! { dg-additional-options "-ffree-line-length-none" } +subroutine foo (x, a) + implicit none + integer, value :: x + integer, contiguous :: a(0:) + external :: bar + integer :: i + + !$omp masked + call bar () + !$omp end masked + + !$omp masked filter (0) + call bar () + !$omp end masked + + !$omp masked filter (7) + call bar () + !$omp end masked + + !$omp masked filter (x) + call bar () + !$omp end masked + + !$omp masked taskloop simd filter (x) grainsize (12) simdlen (4) + do i = 0, 127 + a(i) = i + end do + !$omp end masked taskloop simd + + !$omp parallel masked filter (x) firstprivate (x) + call bar () + !$omp end parallel masked + + !$omp masked + !$omp masked filter (0) + !$omp masked filter (x) + !$omp end masked + !$omp end masked + !$omp end masked +end + +subroutine foobar (d, f, fi, p, s, g, i1, i2, l, ll, nth, ntm, pp, q, r, r2) + implicit none (type, external) + logical :: i1, i2, fi + integer :: i, d, f, p, s, g, l, ll, nth, ntm, pp, q, r, r2 + allocatable :: q + integer, save :: t + !$omp threadprivate (t) + + !$omp parallel masked & + !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & + !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) ! allocate (f) + ! + !$omp end parallel masked + + !$omp taskgroup task_reduction (+:r2) ! allocate (r2) + !$omp masked taskloop & + !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) final(fi) mergeable priority (pp) & + !$omp& reduction(default, +:r) in_reduction(+:r2) filter (d) ! allocate (f) + do i = 0, 63 + ll = ll + 1 + end do + !$omp end masked taskloop + !$omp end taskgroup + + !$omp taskgroup task_reduction (+:r2) ! allocate (r2) + !$omp masked taskloop simd & + !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & + !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & + !$omp& order(concurrent) filter (d) ! allocate (f) + do i = 0, 63 + ll = ll + 1 + end do + !$omp end masked taskloop simd + !$omp end taskgroup + + !$omp parallel masked taskloop & + !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) final(fi) mergeable priority (pp) & + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) ! allocate (f) + do i = 0, 63 + ll = ll + 1 + end do + !$omp end parallel masked taskloop + + !$omp parallel masked taskloop simd & + !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & + !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& order(concurrent) filter (d) ! allocate (f) + do i = 0, 63 + ll = ll + 1 + end do + !$omp end parallel masked taskloop simd +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 new file mode 100644 index 0000000..95ef78c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 @@ -0,0 +1,46 @@ +module m + implicit none (external, type) + type t + end type t +contains +subroutine foo (x, y, z, a) + external :: bar + type(t) :: x + integer :: y + real :: z + integer :: a(4) + + !$omp masked filter (x) ! { dg-error "FILTER clause at .1. requires a scalar INTEGER expression" } + call bar () + !$omp end masked + + !$omp masked filter (y) ! OK + call bar () + !$omp end masked + + !$omp masked filter (z) ! { dg-error "FILTER clause at .1. requires a scalar INTEGER expression" } + call bar () + !$omp end masked + + !$omp masked filter (a) ! { dg-error "FILTER clause at .1. requires a scalar INTEGER expression" } + call bar () + !$omp end masked + + !$omp masked filter (0.0) ! { dg-error "FILTER clause at .1. requires a scalar INTEGER expression" } + call bar () + !$omp end masked + + !$omp masked filter ([1]) ! { dg-error "FILTER clause at .1. requires a scalar INTEGER expression" } + call bar () + !$omp end masked + + !$omp masked filter (-1) ! { dg-warning "INTEGER expression of FILTER clause at .1. must be non-negative" } + call bar () + !$omp end masked +end +end module + +subroutine bar + !$omp masked filter (0) filter (0) ! { dg-error "27: Failed to match clause" } + call foobar +end diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-3.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-3.f90 new file mode 100644 index 0000000..49c633d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/masked-3.f90 @@ -0,0 +1,12 @@ +subroutine foo + + !$omp masked + goto 55 ! { dg-error "invalid branch to/from OpenMP structured block" } + ! { dg-warning "Legacy Extension: Label at .1. is not in the same block as the GOTO statement" "" { target *-*-* } .-1 } + !$omp end masked + + !$omp masked +55 continue ! { dg-warning "Legacy Extension: Label at .1. is not in the same block as the GOTO statement" } + return ! { dg-error "invalid branch to/from OpenMP structured block" } + !$omp end masked +end subroutine foo diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-combined-1.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-combined-1.f90 new file mode 100644 index 0000000..23ffb08 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/masked-combined-1.f90 @@ -0,0 +1,65 @@ +subroutine foo (a, f) + implicit none (type, external) + interface + subroutine bar (x) + integer :: x + end subroutine + end interface + + integer, value :: f + integer, contiguous :: a(0:) + integer :: i, j, k, u, v, w, x, y, z + + !$omp parallel masked default(none) private (k) filter (f) firstprivate (f) + call bar (k) + !$omp end parallel masked + + !$omp parallel masked default(none) private (k) + call bar (k) + !$omp end parallel masked + + !$omp parallel default(none) firstprivate(a, f) shared(x, y, z) + !$omp masked taskloop reduction (+:x) default(none) firstprivate(a) filter (f) + do i = 0, 63 + x = x + a(i) + end do + !$omp end masked taskloop + !$omp masked taskloop simd reduction (+:y) default(none) firstprivate(a) private (i) filter (f) + do i = 0, 63 + y = y + a(i) + end do + !$omp end masked taskloop simd + !$omp masked taskloop simd reduction (+:y) default(none) firstprivate(a) private (i) + do i = 0, 63 + y = y + a(i) + end do + !$omp end masked taskloop simd + !$omp masked taskloop simd collapse(2) reduction (+:z) default(none) firstprivate(a) private (i, j) filter (f) + do j = 0, 0 + do i = 0, 63 + z = z + a(i) + end do + end do + !$omp end masked taskloop simd + !$omp end parallel + + !$omp parallel masked taskloop reduction (+:u) default(none) firstprivate(a, f) filter (f) + do i = 0, 63 + u = u + a(i) + end do + !$omp end parallel masked taskloop + + !$omp parallel masked taskloop simd reduction (+:v) default(none) firstprivate(a, f) filter (f) + do i = 0, 63 + v = v + a(i) + end do + !$omp end parallel masked taskloop simd + + !$omp parallel masked taskloop simd collapse(2) reduction (+:w) default(none) firstprivate(a, f) filter (f) + do j = 0, 0 + do i = 0, 63 + w = w + a(i) + end do + end do + !$omp end parallel masked taskloop simd +end diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-combined-2.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-combined-2.f90 new file mode 100644 index 0000000..c94425f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/masked-combined-2.f90 @@ -0,0 +1,24 @@ +subroutine foo (a) + implicit none (external, type) + integer, contiguous :: a(0:) + integer :: i, r, s + r = 0; s = 0 + + ! In 'parallel masked taskloop', in_reduction is not permitted. + + !$omp taskgroup task_reduction(+:r) + !$omp parallel masked taskloop in_reduction(+:r) ! { dg-error "36: Failed to match clause" } + do i = 0, 63 + r = r + a(i) + end do + !!$omp end parallel masked taskloop + !$omp end taskgroup + + !$omp taskgroup task_reduction(+:s) + !$omp parallel masked taskloop simd in_reduction(+:s) ! { dg-error "41: Failed to match clause" } + do i = 0, 63 + s = s + a(i) + end do + !!$omp end parallel masked taskloop simd + !$omp end taskgroup +end diff --git a/libgomp/testsuite/libgomp.fortran/masked-1.f90 b/libgomp/testsuite/libgomp.fortran/masked-1.f90 new file mode 100644 index 0000000..6b7ebc7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/masked-1.f90 @@ -0,0 +1,119 @@ +module m + use omp_lib + implicit none (type, external) +contains + subroutine foo (x, a) + integer, value :: x + integer, contiguous :: a(0:) + integer :: i + + !$omp masked + if (omp_get_thread_num () /= 0) & + stop 1 + a(128) = a(128) + 1 + !$omp end masked + + !$omp masked filter (0) + if (omp_get_thread_num () /= 0) & + stop 2 + a(129) = a(129) + 1 + !$omp end masked + + !$omp masked filter (7) + if (omp_get_thread_num () /= 7) & + stop 3 + a(130) = a(130) + 1 + !$omp end masked + + !$omp masked filter (x) + if (omp_get_thread_num () /= x) & + stop 4 + a(131) = a(131) + 1 + !$omp end masked + + !$omp masked taskloop simd filter (x) shared(a) grainsize (12) simdlen (4) + do i = 0, 127 + a(i) = a(i) + i + end do + !$omp end masked taskloop simd + end +end + +program main + use m + implicit none (type, external) + integer :: i + integer :: a(0:135) + + a = 0 + + !$omp parallel num_threads (4) + call foo (4, a) + !$omp end parallel + do i = 0, 127 + if (a(i) /= 0) & + stop 5 + end do + if (a(128) /= 1 .or. a(129) /= 1 .or. a(130) /= 0 .or. a(131) /= 0) & + stop 6 + + !$omp parallel num_threads (4) + call foo (3, a) + !$omp end parallel + do i = 0, 127 + if (a(i) /= i) & + stop 7 + end do + if (a(128) /= 2 .or. a(129) /= 2 .or. a(130) /= 0 .or. a(131) /= 1) & + stop 8 + + !$omp parallel num_threads (8) + call foo (8, a) + !$omp end parallel + do i = 0, 127 + if (a(i) /= i) & + stop 9 + end do + if (a(128) /= 3 .or. a(129) /= 3 .or. a(130) /= 1 .or. a(131) /= 1) & + stop 10 + + !$omp parallel num_threads (8) + call foo (6, a) + !$omp end parallel + do i = 0, 127 + if (a(i) /= 2 * i) & + stop 11 + end do + if (a(128) /= 4 .or. a(129) /= 4 .or. a(130) /= 2 .or. a(131) /= 2) & + stop 12 + + do i = 0, 7 + a(i) = 0 + end do + ! The filter expression can evaluate to different values in different threads. + !$omp parallel masked num_threads (8) filter (omp_get_thread_num () + 1) + a(omp_get_thread_num ()) = a(omp_get_thread_num ()) + 1 + !$omp end parallel masked + do i = 0, 7 + if (a(i) /= 0) & + stop 13 + end do + + ! And multiple threads can be filtered. + !$omp parallel masked num_threads (8) filter (iand (omp_get_thread_num (), not(1))) + a(omp_get_thread_num ()) = a(omp_get_thread_num ()) + 1 + !$omp end parallel masked + do i = 0, 7 + block + integer :: j + j = iand (i, 1) + if (j /= 0) then + j = 0 + else + j = 1 + end if + if (a(i) /= j) & + stop 14 + end block + end do +end program main -- 2.7.4