summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFrederik Harwath <frederik@codesourcery.com>2023-03-24 18:11:57 +0100
committerFrederik Harwath <frederik@codesourcery.com>2023-03-27 12:44:09 +0200
commit1091d03bbc04b7c4ec386041b48c6e0144f4bc72 (patch)
tree2111bb0d1cab5dc153d3aaa97f9e2de0c92cf7f9
parentae2dca26602678f8b70e22da1bce8302c0751b75 (diff)
downloadgcc-1091d03bbc04b7c4ec386041b48c6e0144f4bc72.tar.gz
openmp: Add Fortran support for "omp unroll" directive
This commit implements the OpenMP 5.1 "omp unroll" directive for Fortran. The Fortran front end changes encompass the parsing and the verification of nesting restrictions etc. The actual loop transformation is implemented in a new language-independent "omp_transform_loops" pass which runs before omp lowering. No attempt is made to re-use existing unrolling optimizations because a separate implementation allows for better control of the unrolling. The new pass will also serve as a foundation for the implementation of further OpenMP loop transformations. This commit only implements the support for "omp unroll" on the outermost loop of a loop nest. The support for inner loops will be added later. gcc/ChangeLog: * Makefile.in: Add omp_transform_loops.o. * gimple-pretty-print.cc (dump_gimple_omp_for): Handle "full" and "partial" clauses. * gimple.h (enum gf_mask): Add GF_OMP_FOR_KIND_TRANSFORM_LOOP. * gimplify.cc (is_gimple_stmt): Handle OMP_UNROLL. (gimplify_scan_omp_clauses): Handle OMP_UNROLL_FULL, OMP_UNROLL_NONE, and OMP_UNROLL_PARTIAL. (gimplify_adjust_omp_clauses): Handle OMP_UNROLL_FULL, OMP_UNROLL_NONE, and OMP_UNROLL_PARTIAL. (gimplify_omp_for): Handle OMP_UNROLL. (gimplify_expr): Likewise. * params.opt: Add omp-unroll-full-max-iteration and omp-unroll-default-factor. * passes.def: Add pass_omp_transform_loop before pass_lower_omp. * tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_UNROLL_NONE, OMP_CLAUSE_UNROLL_FULL, and OMP_CLAUSE_UNROLL_PARTIAL. * tree-pass.h (make_pass_omp_transform_loops): Declare pmake_pass_omp_transform_loops. * tree-pretty-print.cc (dump_omp_clause): Handle OMP_CLAUSE_UNROLL_NONE, OMP_CLAUSE_UNROLL_FULL, and OMP_CLAUSE_UNROLL_PARTIAL. (dump_generic_node): Handle OMP_UNROLL. * tree.cc (omp_clause_num_ops): Add number of operators for OMP_CLAUSE_UNROLL_FULL, OMP_CLAUSE_UNROLL_NONE, and OMP_CLAUSE_UNROLL_PARTIAl. (omp_clause_code_names): Add name strings for OMP_CLAUSE_UNROLL_FULL, OMP_CLAUSE_UNROLL_NONE, and OMP_CLAUSE_UNROLL_PARTIAL. * tree.def (OMP_UNROLL): Define. * tree.h (OMP_CLAUSE_UNROLL_PARTIAL_EXPR): Define. * omp-transform-loops.cc: New file. * omp-general.cc (omp_loop_transform_clause_p): New function. * omp-general.h (omp_loop_transform_clause_p): New declaration. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_clauses): Handle "unroll full" and "unroll partial". (show_omp_node): Handle OMP_UNROLL. (show_code_node): Handle EXEC_OMP_UNROLL. * gfortran.h (enum gfc_statement): Add ST_OMP_UNROLL, ST_OMP_END_UNROLL. (enum gfc_exec_op): Add EXEC_OMP_UNROLL. * match.h (gfc_match_omp_unroll): Declare. * openmp.cc (enum omp_mask2): Add OMP_CLAUSE_UNROLL_FULL, OMP_CLAUSE_UNROLL_NONE, OMP_CLAUSE_UNROLL_PARTIAL. (gfc_match_omp_clauses): Handle "omp unroll partial". (OMP_UNROLL_CLAUSES): New macro definition. (gfc_match_omp_unroll): Match "full" clause. (omp_unroll_removes_loop_nest): New function. (resolve_omp_unroll): New function. (resolve_omp_do): Accept and verify "omp unroll" directives between directive and loop. (omp_code_to_statement): Handle EXEC_OMP_UNROLL. (gfc_resolve_omp_directive): Likewise. * parse.cc (decode_omp_directive): Handle "undroll" and "end unroll". (next_statement): Handle ST_OMP_UNROLL. (gfc_ascii_statement): Handle ST_OMP_UNROLL and ST_OMP_END_UNROLL. (parse_omp_do): Accept ST_OMP_UNROLL and ST_OMP_END_UNROLL before/after loop. (parse_executable): Handle ST_OMP_UNROLL. * resolve.cc (gfc_resolve_blocks): Handle EXEC_OMP_UNROLL. (gfc_resolve_code): Likewise. * st.cc (gfc_free_statement): Likewise. * trans-openmp.cc (gfc_trans_omp_clauses): Handle unroll clauses. (gfc_trans_omp_do): Handle OMP_CLAUSE_UNROLL_FULL, OMP_CLAUSE_UNROLL_PARTIAL, OMP_CLAUSE_UNROLL_NONE creation. (gfc_trans_omp_directive): Handle EXEC_OMP_UNROLL. * trans.cc (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/loop-transforms/unroll-1.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-2.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-3.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-4.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-5.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-6.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-7.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-7a.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-7b.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-7c.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-8.f90: New test. * testsuite/libgomp.fortran/loop-transforms/unroll-simd-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/loop-transforms/unroll-1.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-2.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-3.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-4.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-5.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-6.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-7.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-9.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-no-clause-1.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-no-clause-2.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-no-clause-3.f90: New test. * gfortran.dg/gomp/loop-transforms/unroll-simd-1.f90: New test.
-rw-r--r--gcc/Makefile.in1
-rw-r--r--gcc/fortran/dump-parse-tree.cc15
-rw-r--r--gcc/fortran/gfortran.h9
-rw-r--r--gcc/fortran/match.h1
-rw-r--r--gcc/fortran/openmp.cc174
-rw-r--r--gcc/fortran/parse.cc34
-rw-r--r--gcc/fortran/resolve.cc3
-rw-r--r--gcc/fortran/st.cc1
-rw-r--r--gcc/fortran/trans-openmp.cc71
-rw-r--r--gcc/fortran/trans.cc1
-rw-r--r--gcc/gimple-pretty-print.cc6
-rw-r--r--gcc/gimple.h1
-rw-r--r--gcc/gimplify.cc40
-rw-r--r--gcc/omp-general.cc14
-rw-r--r--gcc/omp-general.h1
-rw-r--r--gcc/omp-transform-loops.cc1391
-rw-r--r--gcc/params.opt9
-rw-r--r--gcc/passes.def1
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-1.f90277
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-10.f907
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-11.f9075
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-12.f9029
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-2.f9022
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-3.f9017
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-4.f9018
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-5.f9018
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-6.f9019
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-7.f9062
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-8.f9022
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-9.f9018
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-1.f9020
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-2.f9021
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-3.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-1.f90244
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-2.f9057
-rw-r--r--gcc/tree-core.h9
-rw-r--r--gcc/tree-pass.h1
-rw-r--r--gcc/tree-pretty-print.cc20
-rw-r--r--gcc/tree.cc6
-rw-r--r--gcc/tree.def6
-rw-r--r--gcc/tree.h3
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-1.f9052
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-2.f9088
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-3.f9059
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-4.f9072
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-5.f9055
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-6.f90105
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7.f90198
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7a.f907
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7b.f907
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7c.f907
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-8.f9038
-rw-r--r--libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-simd-1.f9033
53 files changed, 3471 insertions, 17 deletions
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 3454e146546..9f7f8dc5825 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -1518,6 +1518,7 @@ OBJS = \
omp-expand.o \
omp-general.o \
omp-low.o \
+ omp-transform-loops.o \
omp-oacc-kernels-decompose.o \
omp-oacc-neuter-broadcast.o \
omp-simd-clone.o \
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 7dad3ac0307..00ed9382024 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -2082,6 +2082,16 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
}
if (omp_clauses->assume)
show_omp_assumes (omp_clauses->assume);
+ if (omp_clauses->unroll_full)
+ {
+ fputs (" FULL", dumpfile);
+ }
+ if (omp_clauses->unroll_partial)
+ {
+ fputs (" PARTIAL", dumpfile);
+ if (omp_clauses->unroll_partial_factor > 0)
+ fprintf (dumpfile, "(%u)", omp_clauses->unroll_partial_factor);
+ }
}
/* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -2194,6 +2204,7 @@ show_omp_node (int level, gfc_code *c)
name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break;
case EXEC_OMP_TEAMS_LOOP: name = "TEAMS LOOP"; break;
+ case EXEC_OMP_UNROLL: name = "UNROLL"; break;
case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
default:
gcc_unreachable ();
@@ -2270,6 +2281,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TEAMS_LOOP:
+ case EXEC_OMP_UNROLL:
case EXEC_OMP_WORKSHARE:
omp_clauses = c->ext.omp_clauses;
break;
@@ -2350,6 +2362,8 @@ show_omp_node (int level, gfc_code *c)
clause = clause->next;
}
}
+ else if (c->op == EXEC_OMP_UNROLL)
+ show_code (level + 1, c->block != NULL ? c->block->next : c->next);
else
show_code (level + 1, c->block->next);
if (c->op == EXEC_OMP_ATOMIC)
@@ -3530,6 +3544,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TEAMS_LOOP:
+ case EXEC_OMP_UNROLL:
case EXEC_OMP_WORKSHARE:
show_omp_node (level, c);
break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cfd9d1ee308..835a8f5f003 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -319,7 +319,8 @@ enum gfc_statement
ST_OMP_METADIRECTIVE, ST_OMP_BEGIN_METADIRECTIVE, ST_OMP_END_METADIRECTIVE,
ST_OMP_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES,
/* Note: gfc_match_omp_nothing returns ST_NONE. */
- ST_OMP_NOTHING, ST_NONE
+ ST_OMP_NOTHING, ST_NONE,
+ ST_OMP_UNROLL, ST_OMP_END_UNROLL
};
/* Types of interfaces that we can have. Assignment interfaces are
@@ -1578,6 +1579,8 @@ typedef struct gfc_omp_clauses
unsigned order_unconstrained:1, order_reproducible:1, capture:1;
unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
unsigned non_rectangular:1, order_concurrent:1;
+ unsigned unroll_full:1, unroll_none:1, unroll_partial:1;
+ unsigned unroll_partial_factor;
ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
@@ -3003,6 +3006,7 @@ enum gfc_exec_op
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
EXEC_OMP_METADIRECTIVE,
+ EXEC_OMP_UNROLL,
EXEC_OMP_ERROR
};
@@ -3902,6 +3906,9 @@ void gfc_generate_module_code (gfc_namespace *);
/* trans-intrinsic.cc */
bool gfc_inline_intrinsic_function_p (gfc_expr *);
+/* trans-openmp.cc */
+bool loop_transform_p (gfc_exec_op op);
+
/* bbt.cc */
typedef int (*compare_fn) (void *, void *);
void gfc_insert_bbt (void *, void *, compare_fn);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 1e1ce2b1eeb..d20a9ef6560 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -229,6 +229,7 @@ match gfc_match_omp_teams_distribute_parallel_do_simd (void);
match gfc_match_omp_teams_distribute_simd (void);
match gfc_match_omp_teams_loop (void);
match gfc_match_omp_threadprivate (void);
+match gfc_match_omp_unroll (void);
match gfc_match_omp_workshare (void);
match gfc_match_omp_end_critical (void);
match gfc_match_omp_end_nowait (void);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 9cbb1728e72..e9b8d11e18a 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -1089,6 +1089,9 @@ enum omp_mask1
/* More OpenMP clauses and OpenACC 2.0+ specific clauses. */
enum omp_mask2
{
+ OMP_CLAUSE_UNROLL_FULL, /* OpenMP 5.1. */
+ OMP_CLAUSE_UNROLL_NONE, /* OpenMP 5.1. */
+ OMP_CLAUSE_UNROLL_PARTIAL, /* OpenMP 5.1. */
OMP_CLAUSE_ASYNC,
OMP_CLAUSE_NUM_GANGS,
OMP_CLAUSE_NUM_WORKERS,
@@ -3088,6 +3091,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
true)
== MATCH_YES))
continue;
+ if ((mask & OMP_CLAUSE_UNROLL_FULL)
+ && (m = gfc_match_dupl_check (!c->unroll_full, "full"))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ c->unroll_full = needs_space = true;
+ continue;
+ }
break;
case 'g':
if ((mask & OMP_CLAUSE_GANG)
@@ -3740,10 +3752,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
break;
case 'p':
- if ((mask & OMP_CLAUSE_COPY)
- && gfc_match ("pcopy ( ") == MATCH_YES
+ if (mask & OMP_CLAUSE_UNROLL_PARTIAL)
+ {
+ if ((m = gfc_match_dupl_check (!c->unroll_partial, "partial"))
+ != MATCH_NO)
+ {
+ int unroll_factor;
+ if (m == MATCH_ERROR)
+ goto error;
+
+ c->unroll_partial = true;
+
+ gfc_expr *cexpr = NULL;
+ m = gfc_match (" ( %e )", &cexpr);
+ if (m == MATCH_NO)
+ ;
+ else if (m == MATCH_YES
+ && !gfc_extract_int (cexpr, &unroll_factor, -1)
+ && unroll_factor > 0)
+ c->unroll_partial_factor = unroll_factor;
+ else
+ gfc_error_now ("PARTIAL clause argument not constant "
+ "positive integer at %C");
+ gfc_free_expr (cexpr);
+ continue;
+ }
+ }
+ if ((mask & OMP_CLAUSE_COPY) && gfc_match ("pcopy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM, true, allow_derived))
+ OMP_MAP_TOFROM, true,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYIN)
&& gfc_match ("pcopyin ( ") == MATCH_YES
@@ -4857,6 +4895,8 @@ cleanup:
(omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY)
#define OMP_WORKSHARE_CLAUSES \
omp_mask (OMP_CLAUSE_NOWAIT)
+#define OMP_UNROLL_CLAUSES \
+ (omp_mask (OMP_CLAUSE_UNROLL_FULL) | OMP_CLAUSE_UNROLL_PARTIAL)
static match
@@ -7138,6 +7178,20 @@ gfc_match_omp_teams_distribute_simd (void)
| OMP_SIMD_CLAUSES);
}
+match
+gfc_match_omp_unroll (void)
+{
+ match m = match_omp (EXEC_OMP_UNROLL, OMP_UNROLL_CLAUSES);
+
+ /* Add an internal clause as a marker to indicate that this "unroll"
+ directive had no clause. */
+ if (new_st.ext.omp_clauses
+ && !new_st.ext.omp_clauses->unroll_full
+ && !new_st.ext.omp_clauses->unroll_partial)
+ new_st.ext.omp_clauses->unroll_none = true;
+
+ return m;
+}
match
gfc_match_omp_workshare (void)
@@ -10080,6 +10134,75 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
}
}
+
+static bool
+omp_unroll_removes_loop_nest (gfc_code *code)
+{
+ gcc_checking_assert (code->op == EXEC_OMP_UNROLL);
+ if (!code->ext.omp_clauses)
+ return true;
+
+ if (code->ext.omp_clauses->unroll_none)
+ {
+ gfc_warning (0, "!$OMP UNROLL without PARTIAL clause at %L turns loop "
+ "into a non-loop",
+ &code->loc);
+ return true;
+ }
+ if (code->ext.omp_clauses->unroll_full)
+ {
+ gfc_warning (0, "!$OMP UNROLL with FULL clause at %L turns loop into a "
+ "non-loop",
+ &code->loc);
+ return true;
+ }
+ return false;
+}
+
+static void
+resolve_loop_transform_generic (gfc_code *code, const char *descr)
+{
+ gcc_assert (code->block);
+
+ if (code->block->op == EXEC_OMP_UNROLL
+ && !omp_unroll_removes_loop_nest (code->block))
+ return;
+
+ if (code->block->next->op == EXEC_OMP_UNROLL
+ && !omp_unroll_removes_loop_nest (code->block->next))
+ return;
+
+ if (code->block->next->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("%s invalid around DO WHILE or DO without loop "
+ "control at %L", descr, &code->loc);
+ return;
+ }
+ if (code->block->next->op == EXEC_DO_CONCURRENT)
+ {
+ gfc_error ("%s invalid around DO CONCURRENT loop at %L",
+ descr, &code->loc);
+ return;
+ }
+
+ gfc_error ("missing canonical loop nest after %s at %L",
+ descr, &code->loc);
+
+}
+
+static void
+resolve_omp_unroll (gfc_code *code)
+{
+ if (!code->block || code->block->op == EXEC_DO)
+ return;
+
+ if (code->block->next->op == EXEC_DO)
+ return;
+
+ resolve_loop_transform_generic (code, "!$OMP UNROLL");
+}
+
+
static void
handle_local_var (gfc_symbol *sym)
{
@@ -10104,6 +10227,13 @@ is_outer_iteration_variable (gfc_code *code, int depth, gfc_symbol *var)
{
int i;
gfc_code *do_code = code->block->next;
+ while (loop_transform_p (do_code->op)) {
+ if (do_code->block)
+ do_code = do_code->block->next;
+ else
+ do_code = do_code->next;
+ }
+ gcc_checking_assert (!loop_transform_p (do_code->op));
for (i = 1; i < depth; i++)
{
@@ -10122,6 +10252,13 @@ expr_is_invariant (gfc_code *code, int depth, gfc_expr *expr)
{
int i;
gfc_code *do_code = code->block->next;
+ while (loop_transform_p (do_code->op)) {
+ if (do_code->block)
+ do_code = do_code->block->next;
+ else
+ do_code = do_code->next;
+ }
+ gcc_checking_assert (!loop_transform_p (do_code->op));
for (i = 1; i < depth; i++)
{
@@ -10299,6 +10436,7 @@ resolve_omp_do (gfc_code *code)
is_simd = true;
break;
case EXEC_OMP_TEAMS_LOOP: name = "!$OMP TEAMS LOOP"; break;
+ case EXEC_OMP_UNROLL: name = "!$OMP UNROLL"; break;
default: gcc_unreachable ();
}
@@ -10306,6 +10444,23 @@ resolve_omp_do (gfc_code *code)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
do_code = code->block->next;
+ /* Move forward over any loop transformation directives to find the loop. */
+ bool error = false;
+ while (do_code->op == EXEC_OMP_UNROLL)
+ {
+ if (!error && omp_unroll_removes_loop_nest (do_code))
+ {
+ gfc_error ("missing canonical loop nest after %s at %L", name,
+ &code->loc);
+ error = true;
+ }
+ if (do_code->block)
+ do_code = do_code->block->next;
+ else
+ do_code = do_code->next;
+ }
+ gcc_checking_assert (do_code->op != EXEC_OMP_UNROLL);
+
if (code->ext.omp_clauses->orderedc)
collapse = code->ext.omp_clauses->orderedc;
else
@@ -10335,6 +10490,14 @@ resolve_omp_do (gfc_code *code)
&do_code->loc);
break;
}
+ if (do_code->op != EXEC_DO)
+ {
+ gfc_error ("%s must be DO loop at %L", name,
+ &do_code->loc);
+ break;
+ }
+
+ gcc_assert (do_code->op != EXEC_OMP_UNROLL);
gcc_assert (do_code->op == EXEC_DO);
if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
gfc_error ("%s iteration variable must be of type integer at %L",
@@ -10573,6 +10736,8 @@ omp_code_to_statement (gfc_code *code)
return ST_OMP_PARALLEL_LOOP;
case EXEC_OMP_DEPOBJ:
return ST_OMP_DEPOBJ;
+ case EXEC_OMP_UNROLL:
+ return ST_OMP_UNROLL;
default:
gcc_unreachable ();
}
@@ -11176,6 +11341,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_TEAMS_LOOP:
resolve_omp_do (code);
break;
+ case EXEC_OMP_UNROLL:
+ resolve_omp_unroll (code);
+ break;
case EXEC_OMP_ASSUME:
case EXEC_OMP_CANCEL:
case EXEC_OMP_ERROR:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index ca172ee16c9..5301ef668b1 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1017,6 +1017,7 @@ decode_omp_directive (void)
ST_OMP_END_TEAMS_DISTRIBUTE);
matcho ("end teams loop", gfc_match_omp_eos_error, ST_OMP_END_TEAMS_LOOP);
matcho ("end teams", gfc_match_omp_eos_error, ST_OMP_END_TEAMS);
+ matchs ("end unroll", gfc_match_omp_eos_error, ST_OMP_END_UNROLL);
matcho ("end workshare", gfc_match_omp_end_nowait,
ST_OMP_END_WORKSHARE);
break;
@@ -1148,6 +1149,9 @@ decode_omp_directive (void)
matchdo ("threadprivate", gfc_match_omp_threadprivate,
ST_OMP_THREADPRIVATE);
break;
+ case 'u':
+ matchs ("unroll", gfc_match_omp_unroll, ST_OMP_UNROLL);
+ break;
case 'w':
matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
break;
@@ -1745,6 +1749,7 @@ next_statement (void)
case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \
case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \
case ST_OMP_ASSUME: \
+ case ST_OMP_UNROLL: \
case ST_CRITICAL: \
case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
@@ -1800,7 +1805,8 @@ next_statement (void)
case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \
- case ST_OMP_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TEAMS_LOOP
+ case ST_OMP_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TEAMS_LOOP: \
+ case ST_OMP_UNROLL
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@@ -2154,6 +2160,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_END_UNION:
p = "END UNION";
break;
+ case ST_OMP_END_UNROLL:
+ p = "!$OMP END UNROLL";
+ break;
case ST_END_MAP:
p = "END MAP";
break;
@@ -2836,6 +2845,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_THREADPRIVATE:
p = "!$OMP THREADPRIVATE";
break;
+ case ST_OMP_UNROLL:
+ p = "!$OMP UNROLL";
+ break;
case ST_OMP_WORKSHARE:
p = "!$OMP WORKSHARE";
break;
@@ -5310,6 +5322,8 @@ gfc_omp_end_stmt (gfc_statement omp_st,
return ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
case ST_OMP_TEAMS_LOOP:
return ST_OMP_END_TEAMS_LOOP;
+ case ST_OMP_UNROLL:
+ return ST_OMP_END_UNROLL;
default:
break;
}
@@ -5383,6 +5397,7 @@ parse_omp_do (gfc_statement omp_st)
gfc_statement st;
gfc_code *cp, *np;
gfc_state_data s;
+ int num_unroll = 0;
accept_statement (omp_st);
@@ -5399,6 +5414,12 @@ parse_omp_do (gfc_statement omp_st)
unexpected_eof ();
else if (st == ST_DO)
break;
+ else if (st == ST_OMP_UNROLL)
+ {
+ accept_statement (st);
+ num_unroll++;
+ continue;
+ }
else
unexpected_statement (st);
}
@@ -5434,6 +5455,17 @@ parse_omp_do (gfc_statement omp_st)
&& gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
st = omp_end_st;
+ for (; num_unroll > 0; num_unroll--)
+ {
+ if (st == ST_OMP_END_UNROLL)
+ {
+ gfc_clear_new_st ();
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ st = next_statement ();
+ }
+ }
+
if (st == omp_end_st)
{
if (new_st.op == EXEC_OMP_END_NOWAIT)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 15db1252366..9a0cb69d8ff 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10966,6 +10966,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_LOOP:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_UNROLL:
case EXEC_OMP_WORKSHARE:
break;
@@ -11950,6 +11951,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_LOOP:
case EXEC_OMP_SIMD:
case EXEC_OMP_TARGET_SIMD:
+ case EXEC_OMP_UNROLL:
gfc_resolve_omp_do_blocks (code, ns);
break;
case EXEC_SELECT_TYPE:
@@ -12425,6 +12427,7 @@ start:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TEAMS_LOOP:
+ case EXEC_OMP_UNROLL:
case EXEC_OMP_WORKSHARE:
gfc_resolve_omp_directive (code, ns);
break;
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index a02d5c0ce7d..68d2c2239ee 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -278,6 +278,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TEAMS_LOOP:
+ case EXEC_OMP_UNROLL:
case EXEC_OMP_WORKSHARE:
gfc_free_omp_clauses (p->ext.omp_clauses);
break;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 8408d7b5274..8cd40aba18e 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5682,6 +5682,29 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->unroll_full)
+ {
+ c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNROLL_FULL);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
+ if (clauses->unroll_none)
+ {
+ c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNROLL_NONE);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
+ if (clauses->unroll_partial)
+ {
+ c = build_omp_clause (gfc_get_location (&where),
+ OMP_CLAUSE_UNROLL_PARTIAL);
+ OMP_CLAUSE_UNROLL_PARTIAL_EXPR (c)
+ = clauses->unroll_partial_factor ? build_int_cst (
+ integer_type_node, clauses->unroll_partial_factor)
+ : NULL_TREE;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
if (clauses->ordered)
{
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
@@ -6865,6 +6888,12 @@ gfc_trans_omp_cancel (gfc_code *code)
return gfc_finish_block (&block);
}
+bool
+loop_transform_p (gfc_exec_op op)
+{
+ return op == EXEC_OMP_UNROLL;
+}
+
static tree
gfc_trans_omp_cancellation_point (gfc_code *code)
{
@@ -7043,7 +7072,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
{
gfc_se se;
tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
- tree local_dovar = NULL_TREE, cycle_label, tmp, omp_clauses;
+ tree local_dovar = NULL_TREE, cycle_label, tmp, omp_clauses, loop_transform_clauses;
stmtblock_t block;
stmtblock_t body;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
@@ -7054,6 +7083,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps;
gfc_expr_list *tile = do_clauses ? do_clauses->tile_list : clauses->tile_list;
gfc_code *orig_code = code;
+ locus top_loc = code->loc;
/* Both collapsed and tiled loops are lowered the same way. In
OpenACC, those clauses are not compatible, so prioritize the tile
@@ -7071,7 +7101,25 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
if (collapse <= 0)
collapse = 1;
+ if (pblock == NULL)
+ {
+ gfc_start_block (&block);
+ pblock = &block;
+ }
code = code->block->next;
+ gcc_assert (code->op == EXEC_DO || code->op == EXEC_OMP_UNROLL);
+ /* Loop transformation directives surrounding the associated loop of an "omp
+ do" (or similar directive) are represented as clauses on the "omp do". */
+ loop_transform_clauses = NULL;
+ while (code->op == EXEC_OMP_UNROLL)
+ {
+ tree clauses = gfc_trans_omp_clauses (pblock, code->ext.omp_clauses,
+ code->loc);
+ loop_transform_clauses = chainon (loop_transform_clauses, clauses);
+
+ code = code->block ? code->block->next : code->next;
+ }
+ gcc_checking_assert (code->op != EXEC_OMP_UNROLL);
gcc_assert (code->op == EXEC_DO);
init = make_tree_vec (collapse);
@@ -7079,18 +7127,21 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
incr = make_tree_vec (collapse);
orig_decls = clauses->ordered ? make_tree_vec (collapse) : NULL_TREE;
- if (pblock == NULL)
- {
- gfc_start_block (&block);
- pblock = &block;
- }
-
/* simd schedule modifier is only useful for composite do simd and other
constructs including that, where gfc_trans_omp_do is only called
on the simd construct and DO's clauses are translated elsewhere. */
do_clauses->sched_simd = false;
- omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
+ if (op == EXEC_OMP_UNROLL)
+ {
+ /* This is a loop transformation on a loop which is not associated with
+ any other directive. Use the directive location instead of the loop
+ location for the clauses. */
+ omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, top_loc);
+ }
+ else
+ omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
+ omp_clauses = chainon (omp_clauses, loop_transform_clauses);
for (i = 0; i < collapse; i++)
{
@@ -7344,7 +7395,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
}
gcc_assert (local_dovar == dovar || c != NULL);
}
- if (local_dovar != dovar)
+ if (local_dovar != dovar && op != EXEC_OMP_UNROLL)
{
if (op != EXEC_OMP_SIMD || dovar_found == 1)
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
@@ -7433,6 +7484,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
stmt = make_node (OACC_LOOP);
OACC_LOOP_COMBINED (stmt) = combined;
break;
+ case EXEC_OMP_UNROLL: stmt = make_node (OMP_LOOP_TRANS); break;
default: gcc_unreachable ();
}
@@ -9573,6 +9625,7 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_LOOP:
case EXEC_OMP_SIMD:
case EXEC_OMP_TASKLOOP:
+ case EXEC_OMP_UNROLL:
return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
NULL, false);
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 3c3bcb4f72f..46e24f3036f 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2243,6 +2243,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TEAMS_LOOP:
+ case EXEC_OMP_UNROLL:
case EXEC_OMP_WORKSHARE:
res = gfc_trans_omp_directive (code);
break;
diff --git a/gcc/gimple-pretty-print.cc b/gcc/gimple-pretty-print.cc
index 492c3b3909f..15048e78a38 100644
--- a/gcc/gimple-pretty-print.cc
+++ b/gcc/gimple-pretty-print.cc
@@ -1478,6 +1478,9 @@ dump_gimple_omp_for (pretty_printer *buffer, const gomp_for *gs, int spc,
case GF_OMP_FOR_KIND_SIMD:
kind = " simd";
break;
+ case GF_OMP_FOR_KIND_TRANSFORM_LOOP:
+ kind = " unroll";
+ break;
default:
gcc_unreachable ();
}
@@ -1515,6 +1518,9 @@ dump_gimple_omp_for (pretty_printer *buffer, const gomp_for *gs, int spc,
case GF_OMP_FOR_KIND_SIMD:
pp_string (buffer, "#pragma omp simd");
break;
+ case GF_OMP_FOR_KIND_TRANSFORM_LOOP:
+ pp_string (buffer, "#pragma omp loop_transform");
+ break;
default:
gcc_unreachable ();
}
diff --git a/gcc/gimple.h b/gcc/gimple.h
index 7af58c4ae90..8a747766e8e 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -162,6 +162,7 @@ enum gf_mask {
GF_OMP_FOR_KIND_TASKLOOP = 2,
GF_OMP_FOR_KIND_OACC_LOOP = 4,
GF_OMP_FOR_KIND_SIMD = 5,
+ GF_OMP_FOR_KIND_TRANSFORM_LOOP = 6,
GF_OMP_FOR_COMBINED = 1 << 3,
GF_OMP_FOR_COMBINED_INTO = 1 << 4,
GF_OMP_TARGET_KIND_MASK = (1 << 5) - 1,
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index dda04947f69..f8ca924e1d2 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -5923,6 +5923,7 @@ is_gimple_stmt (tree t)
case OACC_CACHE:
case OMP_PARALLEL:
case OMP_FOR:
+ case OMP_LOOP_TRANS:
case OMP_SIMD:
case OMP_DISTRIBUTE:
case OMP_LOOP:
@@ -11553,6 +11554,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
}
break;
+ case OMP_CLAUSE_UNROLL_FULL:
+ case OMP_CLAUSE_UNROLL_NONE:
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ break;
case OMP_CLAUSE_NOHOST:
default:
gcc_unreachable ();
@@ -12651,6 +12656,9 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_INCLUSIVE:
case OMP_CLAUSE_EXCLUSIVE:
+ case OMP_CLAUSE_UNROLL_FULL:
+ case OMP_CLAUSE_UNROLL_NONE:
+ case OMP_CLAUSE_UNROLL_PARTIAL:
break;
case OMP_CLAUSE_NOHOST:
@@ -13453,6 +13461,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
case OMP_SIMD:
ort = ORT_SIMD;
break;
+ case OMP_LOOP_TRANS:
+ break;
default:
gcc_unreachable ();
}
@@ -13830,8 +13840,19 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
n->value &= ~GOVD_LASTPRIVATE_CONDITIONAL;
}
}
- else
- omp_add_variable (gimplify_omp_ctxp, decl, GOVD_PRIVATE | GOVD_SEEN);
+ else {
+ if (TREE_CODE(orig_for_stmt) == OMP_LOOP_TRANS)
+ {
+ /* This loop is not going to be associated with any
+ directive after its transformation in
+ pass-omp_transform_loops. It will be lowered there
+ and the loop iteration variable will be used in the
+ context. */
+ omp_notice_variable(gimplify_omp_ctxp, decl, true);
+ }
+ else
+ omp_add_variable(gimplify_omp_ctxp, decl, GOVD_PRIVATE | GOVD_SEEN);
+ }
/* If DECL is not a gimple register, create a temporary variable to act
as an iteration counter. This is valid, since DECL cannot be
@@ -13872,7 +13893,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
c2 = NULL_TREE;
}
}
- else
+ else if (TREE_CODE (orig_for_stmt) != OMP_LOOP_TRANS)
omp_add_variable (gimplify_omp_ctxp, var,
GOVD_PRIVATE | GOVD_SEEN);
}
@@ -14153,6 +14174,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
case OMP_DISTRIBUTE: kind = GF_OMP_FOR_KIND_DISTRIBUTE; break;
case OMP_TASKLOOP: kind = GF_OMP_FOR_KIND_TASKLOOP; break;
case OACC_LOOP: kind = GF_OMP_FOR_KIND_OACC_LOOP; break;
+ case OMP_LOOP_TRANS: kind = GF_OMP_FOR_KIND_TRANSFORM_LOOP; break;
default:
gcc_unreachable ();
}
@@ -14337,6 +14359,13 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
gtask_clauses_ptr = &OMP_CLAUSE_CHAIN (c);
}
break;
+ /* Move loop transformations to inner loop */
+ case OMP_CLAUSE_UNROLL_FULL:
+ case OMP_CLAUSE_UNROLL_NONE:
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ *gfor_clauses_ptr = c;
+ gfor_clauses_ptr = &OMP_CLAUSE_CHAIN (c);
+ break;
default:
gcc_unreachable ();
}
@@ -14777,6 +14806,10 @@ gimplify_omp_loop (tree *expr_p, gimple_seq *pre_p)
}
pc = &OMP_CLAUSE_CHAIN (*pc);
break;
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ case OMP_CLAUSE_UNROLL_FULL:
+ case OMP_CLAUSE_UNROLL_NONE:
+ break;
default:
gcc_unreachable ();
}
@@ -16822,6 +16855,7 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
case OMP_FOR:
case OMP_DISTRIBUTE:
case OMP_TASKLOOP:
+ case OMP_LOOP_TRANS:
case OACC_LOOP:
ret = gimplify_omp_for (expr_p, pre_p);
break;
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index aae5d105bdb..899aae62cda 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -2402,6 +2402,20 @@ omp_declare_variant_remove_hook (struct cgraph_node *node, void *)
}
}
+/* Return true if C is a clause that represents an OpenMP loop transformation
+ directive, false otherwise. */
+
+bool
+omp_loop_transform_clause_p (tree c)
+{
+ if (c == NULL)
+ return false;
+
+ enum omp_clause_code code = OMP_CLAUSE_CODE (c);
+ return (code == OMP_CLAUSE_UNROLL_FULL || code == OMP_CLAUSE_UNROLL_PARTIAL
+ || code == OMP_CLAUSE_UNROLL_NONE);
+}
+
/* Try to resolve declare variant, return the variant decl if it should
be used instead of base, or base otherwise. */
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 1c39eadee00..a2f69872e1c 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -129,6 +129,7 @@ extern tree omp_resolve_declare_variant (tree);
extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (tree);
extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (gimple *);
extern bool omp_has_target_constructor_p (tree);
+extern bool omp_loop_transform_clause_p (tree);
extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/omp-transform-loops.cc b/gcc/omp-transform-loops.cc
new file mode 100644
index 00000000000..3fe95928c2c
--- /dev/null
+++ b/gcc/omp-transform-loops.cc
@@ -0,0 +1,1391 @@
+/* OMP loop transformation pass. Transforms loops according to
+ loop transformations directives such as "omp unroll".
+
+ Copyright (C) 2023 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "pretty-print.h"
+#include "diagnostic-core.h"
+#include "backend.h"
+#include "target.h"
+#include "tree.h"
+#include "tree-inline.h"
+#include "gimple.h"
+#include "gimple-iterator.h"
+#include "tree-pass.h"
+#include "gimple-walk.h"
+#include "gimple-pretty-print.h"
+#include "gimplify.h"
+#include "ssa.h"
+#include "tree-into-ssa.h"
+#include "fold-const.h"
+#include "print-tree.h"
+#include "omp-general.h"
+
+/* Context information for walk_omp_for_loops. */
+struct walk_ctx
+{
+ /* The most recently visited gomp_for that has been transformed and
+ for which gimple_omp_for_set_combined_into_p returned true. */
+ gomp_for *inner_combined_loop;
+
+ /* The innermost bind enclosing the currently visited node. */
+ gbind *bind;
+};
+
+static unsigned int walk_omp_for_loops (gimple_seq *, walk_ctx *);
+static enum tree_code omp_adjust_neq_condition (tree v, tree step);
+
+static bool
+non_rectangular_p (const gomp_for *omp_for)
+{
+ size_t collapse = gimple_omp_for_collapse (omp_for);
+ for (size_t i = 0; i < collapse; i++)
+ {
+ if (TREE_CODE (gimple_omp_for_final (omp_for, i)) == TREE_VEC
+ || TREE_CODE (gimple_omp_for_initial (omp_for, i)) == TREE_VEC)
+ return true;
+ }
+
+ return false;
+}
+
+/* Callback for subst_var. */
+
+static tree
+subst_var_in_op (tree *t, int *subtrees ATTRIBUTE_UNUSED, void *data)
+{
+
+ auto *wi = (struct walk_stmt_info *)data;
+ auto from_to = (std::pair<tree, tree> *)wi->info;
+
+ if (*t == from_to->first)
+ {
+ *t = from_to->second;
+ wi->changed = true;
+ }
+
+ return NULL_TREE;
+}
+
+/* Substitute all occurrences of FROM in the operands of the GIMPLE statements
+ in SEQ by TO. */
+
+static void
+subst_var (gimple_seq *seq, tree from, tree to)
+{
+ gcc_assert (VAR_P (from));
+ gcc_assert (VAR_P (to));
+
+ std::pair<tree, tree> from_to (from, to);
+ struct walk_stmt_info wi;
+ memset (&wi, 0, sizeof (wi));
+ wi.info = (void *)&from_to;
+
+ walk_gimple_seq_mod (seq, NULL, subst_var_in_op, &wi);
+}
+
+/* Return the type that should be used for computing the iteration count of a
+ loop with the given index VAR and upper/lower bound FINAL according to
+ OpenMP 5.1. */
+
+tree
+gomp_for_iter_count_type (tree var, tree final)
+{
+ tree var_type = TREE_TYPE (var);
+
+ if (POINTER_TYPE_P (var_type))
+ return ptrdiff_type_node;
+
+ tree operand_type = TREE_TYPE (final);
+ if (TYPE_UNSIGNED (var_type) && !TYPE_UNSIGNED (operand_type))
+ return signed_type_for (operand_type);
+
+ return var_type;
+}
+
+extern tree
+gimple_assign_rhs_to_tree (gimple *stmt);
+
+/* Substitute all definitions from SEQ bottom-up into EXPR. This is used to
+ reconstruct a tree for a gimplified expression for determinig whether or not
+ the number of iterations of a loop is constant. */
+
+tree
+subst_defs (tree expr, gimple_seq seq)
+{
+ gimple_seq_node last = gimple_seq_last (seq);
+ gimple_seq_node first = gimple_seq_first (seq);
+ for (auto n = last; n != NULL; n = n != first ? n->prev : NULL)
+ {
+ if (!is_gimple_assign (n))
+ continue;
+
+ tree lhs = gimple_assign_lhs (n);
+ tree rhs = gimple_assign_rhs_to_tree (n);
+ std::pair<tree, tree> from_to (lhs, rhs);
+ struct walk_stmt_info wi;
+ memset (&wi, 0, sizeof (wi));
+ wi.info = (void *)&from_to;
+ walk_tree (&expr, subst_var_in_op, &wi, NULL);
+ expr = fold (expr);
+ }
+
+ return expr;
+}
+
+/* Return an expression for the number of iterations of the outermost loop of
+ OMP_FOR. */
+
+tree
+gomp_for_number_of_iterations (const gomp_for *omp_for, size_t level)
+{
+ gcc_assert (!non_rectangular_p (omp_for));
+
+ tree init = gimple_omp_for_initial (omp_for, level);
+ tree final = gimple_omp_for_final (omp_for, level);
+ tree_code cond = gimple_omp_for_cond (omp_for, level);
+ tree index = gimple_omp_for_index (omp_for, level);
+ tree type = gomp_for_iter_count_type (index, final);
+ tree step = TREE_OPERAND (gimple_omp_for_incr (omp_for, level), 1);
+
+ init = subst_defs (init, gimple_omp_for_pre_body (omp_for));
+ init = fold (init);
+ final = subst_defs (final, gimple_omp_for_pre_body (omp_for));
+ final = fold (final);
+
+ tree_code minus_code = MINUS_EXPR;
+ tree diff_type = type;
+ if (POINTER_TYPE_P (TREE_TYPE (final)))
+ {
+ minus_code = POINTER_DIFF_EXPR;
+ diff_type = ptrdiff_type_node;
+ }
+
+ tree diff;
+ if (cond == GT_EXPR)
+ diff = fold_build2 (minus_code, diff_type, init, final);
+ else if (cond == LT_EXPR)
+ diff = fold_build2 (minus_code, diff_type, final, init);
+ else
+ gcc_unreachable ();
+
+ diff = fold_build2 (CEIL_DIV_EXPR, type, diff, step);
+ diff = fold_build1 (ABS_EXPR, type, diff);
+
+ return diff;
+}
+
+/* Return true if the expression representing the number of iterations for
+ OMP_FOR is a constant expression, false otherwise. */
+
+bool
+gomp_for_constant_iterations_p (gomp_for *omp_for,
+ unsigned HOST_WIDE_INT *iterations)
+{
+ tree t = gomp_for_number_of_iterations (omp_for, 0);
+ if (!TREE_CONSTANT (t)
+ || !tree_fits_uhwi_p (t))
+ return false;
+
+ *iterations = tree_to_uhwi (t);
+ return true;
+}
+
+/* Split a gomp_for that represents a collapsed loop-nest into single
+ loops. The result is a gomp_for of the same kind which is not collapsed
+ (i.e. gimple_omp_for_collapse (OMP_FOR) == 1) and which contains nested,
+ non-collapsed gomp_for loops whose kind is GF_OMP_FOR_KIND_TRANSFORM_LOOP
+ (i.e. they will be lowered into plain, non-omp loops by this pass) for each
+ of the loops of OMP_FOR. All loops whose depth is strictly less than
+ FROM_DEPTH are left collapsed. */
+
+static gomp_for*
+gomp_for_uncollapse (gomp_for *omp_for, int from_depth = 0)
+{
+ int collapse = gimple_omp_for_collapse (omp_for);
+ gcc_assert (from_depth < collapse);
+
+ if (collapse <= 1)
+ return omp_for;
+
+ if (dump_enabled_p ())
+ dump_printf_loc (MSG_NOTE | MSG_PRIORITY_INTERNALS, omp_for,
+ "Uncollapsing loop:\n %G\n",
+ static_cast <gimple *> (omp_for));
+
+ gimple_seq body = gimple_omp_body (omp_for);
+ gomp_for *level_omp_for = omp_for;
+ for (int level = collapse - 1; level >= from_depth; level--)
+ {
+ level_omp_for = gimple_build_omp_for (body,
+ GF_OMP_FOR_KIND_TRANSFORM_LOOP,
+ NULL, 1, NULL);
+ gimple_omp_for_set_cond (level_omp_for, 0,
+ gimple_omp_for_cond (omp_for, level));
+ gimple_omp_for_set_initial (level_omp_for, 0,
+ gimple_omp_for_initial (omp_for, level));
+ gimple_omp_for_set_final (level_omp_for, 0,
+ gimple_omp_for_final (omp_for, level));
+ gimple_omp_for_set_incr (level_omp_for, 0,
+ gimple_omp_for_incr (omp_for, level));
+ gimple_omp_for_set_index (level_omp_for, 0,
+ gimple_omp_for_index (omp_for, level));
+
+ body = level_omp_for;
+ }
+
+ omp_for->collapse = from_depth;
+
+ if (from_depth > 0)
+ {
+ gimple_omp_set_body (omp_for, body);
+ return omp_for;
+ }
+
+ gimple_omp_for_set_clauses (level_omp_for, gimple_omp_for_clauses (omp_for));
+ gimple_omp_for_set_pre_body (level_omp_for, gimple_omp_for_pre_body (omp_for));
+ gimple_omp_for_set_combined_into_p (level_omp_for,
+ gimple_omp_for_combined_into_p (omp_for));
+ gimple_omp_for_set_combined_p (level_omp_for,
+ gimple_omp_for_combined_p (omp_for));
+
+ return level_omp_for;
+}
+
+static tree
+build_loop_exit_cond (tree index, tree_code cond, tree final, gimple_seq *seq)
+{
+ tree exit_cond
+ = fold_build1 (TRUTH_NOT_EXPR, boolean_type_node,
+ fold_build2 (cond, boolean_type_node, index, final));
+ tree res = create_tmp_var (boolean_type_node);
+ gimplify_assign (res, exit_cond, seq);
+
+ return res;
+}
+
+/* Returns a register that contains the final value of a loop as described by
+ FINAL. This is necessary for non-rectangular loops. */
+
+static tree
+build_loop_final (tree final, gimple_seq *seq)
+{
+ if (TREE_CODE (final) != TREE_VEC) /* rectangular loop-nest */
+ return final;
+
+ tree coeff = TREE_VEC_ELT (final, 0);
+ tree outer_var = TREE_VEC_ELT (final, 1);
+ tree constt = TREE_VEC_ELT (final, 2);
+
+ tree type = TREE_TYPE (outer_var);
+ tree val = fold_build2 (MULT_EXPR, type, coeff, outer_var);
+ val = fold_build2 (PLUS_EXPR, type, val, constt);
+
+ tree res = create_tmp_var (type);
+ gimplify_assign (res, val, seq);
+
+ return res;
+}
+
+/* Unroll the loop BODY UNROLL_FACTOR times, replacing the INDEX
+ variable by a local copy in each copy of the body that will be
+ incremented as specified by INCR. If BUILD_EXIT_CONDS is true,
+ insert a test of the loop exit condition given COND and FINAL
+ before each copy of the body that will exit the loop if the value
+ of the local index variable satisfies the loop exit condition.
+
+ For example, the unrolling with BUILD_EXIT_CONDS == true turns
+
+ for (i = 0; i < 3; i = i + 1)
+ {
+ BODY
+ }
+
+ into
+
+ for (i = 0; i < n; i = i + 1)
+ {
+ i.0 = i
+ if (!(i_0 < n))
+ goto exit
+ BODY_COPY_1[i/i.0] i.e. index var i replaced by i.0
+ if (!(i_1 < n))
+ goto exit
+ i.1 = i.0 + 1
+ BODY_COPY_2[i/i.1]
+ if (!(i_3 < n))
+ goto exit
+ i.2 = i.2 + 1
+ BODY_COPY_3[i/i.2]
+ exit:
+ }
+ */
+static gimple_seq
+build_unroll_body (gimple_seq body, tree unroll_factor, tree index, tree incr,
+ bool build_exit_conds = false, tree final = NULL_TREE,
+ tree_code *cond = NULL)
+{
+ gcc_assert ((!build_exit_conds && !final && !cond)
+ || (build_exit_conds && final && cond));
+
+ gimple_seq new_body = NULL;
+
+ push_gimplify_context ();
+
+ if (build_exit_conds)
+ final = build_loop_final (final, &new_body);
+
+ tree local_index = create_tmp_var (TREE_TYPE (index));
+ subst_var (&body, index, local_index);
+ tree local_incr = unshare_expr (incr);
+ TREE_OPERAND (local_incr, 0) = local_index;
+
+ tree exit_label = create_artificial_label (gimple_location (body));
+
+ unsigned HOST_WIDE_INT n = tree_to_uhwi (unroll_factor);
+ for (unsigned HOST_WIDE_INT i = 0; i < n; i++)
+ {
+ if (i == 0)
+ gimplify_assign (local_index, index, &new_body);
+ else
+ gimplify_assign (local_index, local_incr, &new_body);
+
+ tree body_copy_label = create_artificial_label (gimple_location (body));
+
+ if (build_exit_conds)
+ {
+ tree exit_cond
+ = build_loop_exit_cond (local_index, *cond, final, &new_body);
+ gimple_seq_add_stmt (
+ &new_body,
+ gimple_build_cond (EQ_EXPR, exit_cond, boolean_true_node,
+ exit_label, body_copy_label));
+ }
+
+ gimple_seq body_copy = copy_gimple_seq_and_replace_locals (body);
+ gimple_seq_add_stmt (&new_body, gimple_build_label (body_copy_label));
+ gimple_seq_add_seq (&new_body, body_copy);
+ }
+
+
+ gbind *bind = gimple_build_bind (NULL, new_body, NULL);
+ pop_gimplify_context (bind);
+
+ gimple_seq result = NULL;
+ gimple_seq_add_stmt (&result, bind);
+ gimple_seq_add_stmt (&result, gimple_build_label (exit_label));
+ return result;
+}
+
+static gimple_seq transform_gomp_for (gomp_for *, tree, walk_ctx *ctx);
+
+/* Execute the partial unrolling transformation for OMP_FOR with the given
+ UNROLL_FACTOR and return the resulting gimple bind. LOC is the location for
+ diagnostic messages.
+
+ Example
+ --------
+ --------
+
+ Original loop
+ -------------
+
+ #pragma omp for unroll_partial(3)
+ for (i = 0; i < 100; i = i + 1)
+ {
+ BODY
+ }
+
+ gets, roughly, translated to
+
+ {
+ #pragma omp for
+ for (i = 0; i < 100; i = i + 3)
+ {
+ i.0 = i
+ if i.0 > 100:
+ goto exit_label
+ BODY_COPY_1[i/i.0] i.e. index var replaced
+ i.1 = i + 1
+ if i.1 > 100:
+ goto exit_label
+ BODY_COPY_2[i/1.1]
+ i.2 = i + 2
+ if i.2 > 100:
+ goto exit_label
+ BODY_COPY_3[i/i.2]
+
+ exit_label:
+ }
+*/
+
+static gimple_seq
+partial_unroll (gomp_for *omp_for, tree unroll_factor,
+ location_t loc, tree transformation_clauses, walk_ctx *ctx)
+{
+ gcc_assert (unroll_factor);
+ gcc_assert (
+ OMP_CLAUSE_CODE (transformation_clauses) == OMP_CLAUSE_UNROLL_PARTIAL
+ || OMP_CLAUSE_CODE (transformation_clauses) == OMP_CLAUSE_UNROLL_NONE);
+
+ /* Partial unrolling reduces the loop nest depth of a canonical loop nest to 1
+ hence outer directives cannot require a greater collapse. */
+ gcc_assert (gimple_omp_for_collapse (omp_for) <= 1);
+
+ if (dump_enabled_p ())
+ dump_printf_loc (MSG_NOTE | MSG_PRIORITY_INTERNALS,
+ dump_user_location_t::from_location_t (loc),
+ "Partially unrolling loop:\n %G\n",
+ static_cast<gimple *> (omp_for));
+
+ gomp_for *unrolled_for = as_a<gomp_for *> (copy_gimple_seq_and_replace_locals (omp_for));
+
+ tree final = gimple_omp_for_final (unrolled_for, 0);
+ tree incr = gimple_omp_for_incr (unrolled_for, 0);
+ tree index = gimple_omp_for_index (unrolled_for, 0);
+ gimple_seq body = gimple_omp_body (unrolled_for);
+
+ tree_code cond = gimple_omp_for_cond (unrolled_for, 0);
+ tree step = TREE_OPERAND (incr, 1);
+ gimple_omp_set_body (unrolled_for,
+ build_unroll_body (body, unroll_factor, index, incr,
+ true, final, &cond));
+
+ gbind *result_bind = gimple_build_bind (NULL, NULL, NULL);
+
+ push_gimplify_context ();
+
+ tree scaled_step
+ = fold_build2 (MULT_EXPR, TREE_TYPE (step),
+ fold_convert (TREE_TYPE (step), unroll_factor), step);
+
+ /* For combined constructs, step will be gimplified on the outer
+ gomp_for. */
+ if (!gimple_omp_for_combined_into_p (omp_for)
+ && !TREE_CONSTANT (scaled_step))
+ {
+ tree var = create_tmp_var (TREE_TYPE (step), ".omp_unroll_step");
+ gimplify_assign (var, scaled_step,
+ gimple_omp_for_pre_body_ptr (unrolled_for));
+ scaled_step = var;
+ }
+ TREE_OPERAND (incr, 1) = scaled_step;
+ gimple_omp_for_set_incr (unrolled_for, 0, incr);
+
+ pop_gimplify_context (result_bind);
+
+ if (gimple_omp_for_combined_into_p (omp_for))
+ ctx->inner_combined_loop = unrolled_for;
+
+ tree remaining_clauses = OMP_CLAUSE_CHAIN (transformation_clauses);
+ gimple_seq_add_stmt (
+ gimple_bind_body_ptr (result_bind),
+ transform_gomp_for (unrolled_for, remaining_clauses, ctx));
+
+ return result_bind;
+}
+
+static gimple_seq
+full_unroll (gomp_for *omp_for, location_t loc, walk_ctx *ctx ATTRIBUTE_UNUSED)
+{
+ tree init = gimple_omp_for_initial (omp_for, 0);
+ unsigned HOST_WIDE_INT niter = 0;
+ if (!gomp_for_constant_iterations_p (omp_for, &niter))
+ {
+ error_at (loc, "Cannot apply full unrolling to loop with "
+ "non-constant number of iterations");
+ return omp_for;
+ }
+
+ if (dump_enabled_p ())
+ dump_printf_loc (MSG_NOTE | MSG_PRIORITY_INTERNALS,
+ dump_user_location_t::from_location_t (loc),
+ "Fully unrolling loop with "
+ HOST_WIDE_INT_PRINT_UNSIGNED
+ " iterations :\n %G\n", niter,
+ static_cast <gimple *>(omp_for));
+
+ tree incr = gimple_omp_for_incr (omp_for, 0);
+ tree index = gimple_omp_for_index (omp_for, 0);
+ gimple_seq body = gimple_omp_body (omp_for);
+
+ tree unroll_factor = build_int_cst (TREE_TYPE (init), niter);
+
+ gimple_seq unrolled = NULL;
+ gimple_seq_add_seq (&unrolled, gimple_omp_for_pre_body (omp_for));
+ push_gimplify_context ();
+ gimple_seq_add_seq (&unrolled,
+ build_unroll_body (body, unroll_factor, index, incr));
+
+ gbind *result_bind = gimple_build_bind (NULL, unrolled, NULL);
+ pop_gimplify_context (result_bind);
+ return result_bind;
+}
+
+/* Decides if the OMP_FOR for which the user did not specify the type of
+ unrolling to apply in the 'unroll' directive represented by the TRANSFORM
+ clause should be fully unrolled. */
+
+static bool
+assign_unroll_full_clause_p (gomp_for *omp_for, tree transform)
+{
+ gcc_assert (OMP_CLAUSE_CODE (transform) == OMP_CLAUSE_UNROLL_NONE);
+ gcc_assert (OMP_CLAUSE_CHAIN (transform) == NULL);
+
+ /* Full unrolling turns the loop into a non-loop and hence
+ the following transformations would fail. */
+ if (TREE_CHAIN (transform) != NULL_TREE)
+ return false;
+
+ unsigned HOST_WIDE_INT num_iters;
+ if (!gomp_for_constant_iterations_p (omp_for, &num_iters)
+ || num_iters
+ > (unsigned HOST_WIDE_INT)param_omp_unroll_full_max_iterations)
+ return false;
+
+ if (dump_enabled_p ())
+ {
+ auto loc = dump_user_location_t::from_location_t (
+ OMP_CLAUSE_LOCATION (transform));
+ dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, loc,
+ "assigned %<full%> clause to %<omp unroll%> with small "
+ "constant number of iterations\n");
+ }
+
+ return true;
+}
+
+/* If the OMP_FOR for which the user did not specify the type of unrolling in
+ the 'unroll' directive in the TRANSFORM clause should be partially unrolled,
+ return the unroll factor, otherwise return null. */
+
+static tree
+assign_unroll_partial_clause_p (gomp_for *omp_for ATTRIBUTE_UNUSED,
+ tree transform)
+{
+ gcc_assert (OMP_CLAUSE_CODE (transform) == OMP_CLAUSE_UNROLL_NONE);
+
+ if (param_omp_unroll_default_factor == 0)
+ return NULL;
+
+ tree unroll_factor
+ = build_int_cst (integer_type_node, param_omp_unroll_default_factor);
+
+ if (dump_enabled_p ())
+ {
+ auto loc = dump_user_location_t::from_location_t (
+ OMP_CLAUSE_LOCATION (transform));
+ dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, loc,
+ "added %<partial(%u)%> clause to %<omp unroll%> directive\n",
+ param_omp_unroll_default_factor);
+ }
+
+ return unroll_factor;
+}
+
+/* Generate the code for an OMP_FOR that represents the result of a
+ loop transformation which is not associated with any directive and
+ which will hence not be lowered in the omp-expansion. */
+
+static gimple_seq
+expand_transformed_loop (gomp_for *omp_for)
+{
+ gcc_assert (gimple_omp_for_kind (omp_for)
+ == GF_OMP_FOR_KIND_TRANSFORM_LOOP);
+
+ if (dump_enabled_p ())
+ dump_printf_loc (MSG_NOTE | MSG_PRIORITY_INTERNALS, omp_for,
+ "Expanding loop:\n %G\n",
+ static_cast <gimple *> (omp_for));
+
+ push_gimplify_context ();
+
+ omp_for = gomp_for_uncollapse (omp_for);
+
+ tree incr = gimple_omp_for_incr (omp_for, 0);
+ tree index = gimple_omp_for_index (omp_for, 0);
+ tree init = gimple_omp_for_initial (omp_for, 0);
+ tree final = gimple_omp_for_final (omp_for, 0);
+ tree_code cond = gimple_omp_for_cond (omp_for, 0);
+ gimple_seq body = gimple_omp_body (omp_for);
+ gimple_seq pre_body = gimple_omp_for_pre_body (omp_for);
+
+ gimple_seq loop = NULL;
+
+ tree exit_label = create_artificial_label (UNKNOWN_LOCATION);
+ tree cycle_label = create_artificial_label (UNKNOWN_LOCATION);
+ tree body_label = create_artificial_label (UNKNOWN_LOCATION);
+
+ gimple_seq_add_seq (&loop, pre_body);
+ gimplify_assign (index, init, &loop);
+ tree final_var = final;
+ if (TREE_CODE (final) != VAR_DECL)
+ {
+ final_var = create_tmp_var (TREE_TYPE (final));
+ gimplify_assign (final_var, final, &loop);
+ }
+
+ gimple_seq_add_stmt (&loop, gimple_build_label (cycle_label));
+ gimple_seq_add_stmt (&loop, gimple_build_cond (cond, index, final_var,
+ body_label, exit_label));
+ gimple_seq_add_stmt (&loop, gimple_build_label (body_label));
+ gimple_seq_add_seq (&loop, body);
+ gimplify_assign (index, incr, &loop);
+ gimple_seq_add_stmt (&loop, gimple_build_goto (cycle_label));
+ gimple_seq_add_stmt (&loop, gimple_build_label (exit_label));
+
+ gbind *bind = gimple_build_bind (NULL, loop, NULL);
+ pop_gimplify_context (bind);
+
+ return bind;
+}
+
+static enum tree_code
+omp_adjust_neq_condition (tree v, tree step)
+{
+ gcc_assert (TREE_CODE (step) == INTEGER_CST);
+ if (TREE_CODE (TREE_TYPE (v)) == INTEGER_TYPE)
+ {
+ if (integer_onep (step))
+ return LT_EXPR;
+ else
+ {
+ gcc_assert (integer_minus_onep (step));
+ return GT_EXPR;
+ }
+ }
+ else
+ {
+ tree unit = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (v)));
+ gcc_assert (TREE_CODE (unit) == INTEGER_CST);
+ if (tree_int_cst_equal (unit, step))
+ return LT_EXPR;
+ else
+ {
+ gcc_assert (wi::neg (wi::to_widest (unit))
+ == wi::to_widest (step));
+ return GT_EXPR;
+ }
+ }
+}
+
+/* Adjust *COND_CODE and *N2 so that the former is either LT_EXPR or GT_EXPR,
+ given that V is the loop index variable and STEP is loop step.
+
+ This function has been derived from omp_adjust_for_condition.
+ In contrast to the original function it does not add 1 or
+ -1 to the the final value when converting <=,>= to <,>
+ for a pointer-type index variable. Instead, this function
+ adds or subtracts the type size in bytes. This is necessary
+ to determine the number of iterations correctly. */
+
+void
+omp_adjust_for_condition2 (location_t loc, enum tree_code *cond_code, tree *n2,
+ tree v, tree step)
+{
+ switch (*cond_code)
+ {
+ case LT_EXPR:
+ case GT_EXPR:
+ break;
+
+ case NE_EXPR:
+ *cond_code = omp_adjust_neq_condition (v, step);
+ break;
+
+ case LE_EXPR:
+ if (POINTER_TYPE_P (TREE_TYPE (*n2)))
+ {
+ tree unit = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (v)));
+ HOST_WIDE_INT type_unit = tree_to_shwi (unit);
+
+ *n2 = fold_build_pointer_plus_hwi_loc (loc, *n2, type_unit);
+ }
+ else
+ *n2 = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (*n2), *n2,
+ build_int_cst (TREE_TYPE (*n2), 1));
+ *cond_code = LT_EXPR;
+ break;
+ case GE_EXPR:
+ if (POINTER_TYPE_P (TREE_TYPE (*n2)))
+ {
+ tree unit = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (v)));
+ HOST_WIDE_INT type_unit = tree_to_shwi (unit);
+ *n2 = fold_build_pointer_plus_hwi_loc (loc, *n2, -1 * type_unit);
+ }
+ else
+ *n2 = fold_build2_loc (loc, MINUS_EXPR, TREE_TYPE (*n2), *n2,
+ build_int_cst (TREE_TYPE (*n2), 1));
+ *cond_code = GT_EXPR;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+}
+
+/* Transform the condition of OMP_FOR to either LT_EXPR or GT_EXPR and adjust
+ the final value as necessary. */
+
+static bool
+canonicalize_conditions (gomp_for *omp_for)
+{
+ size_t collapse = gimple_omp_for_collapse (omp_for);
+ location_t loc = gimple_location (omp_for);
+ bool new_decls = false;
+
+ gimple_seq *pre_body = gimple_omp_for_pre_body_ptr (omp_for);
+ for (size_t l = 0; l < collapse; l++)
+ {
+ enum tree_code cond = gimple_omp_for_cond (omp_for, l);
+
+ if (cond == LT_EXPR || cond == GT_EXPR)
+ continue;
+
+ tree incr = gimple_omp_for_incr (omp_for, l);
+ tree step = omp_get_for_step_from_incr (loc, incr);
+ tree index = gimple_omp_for_index (omp_for, l);
+ tree final = gimple_omp_for_final (omp_for, l);
+ tree orig_final = final;
+ /* If final refers to the index variable of an outer level, i.e.
+ the loop nest is non-rectangular, only convert NE_EXPR. This
+ is necessary for unrolling. Unrolling needs to multiply the
+ step by the unrolling factor, but non-constant step values
+ are impossible with NE_EXPR. */
+ if (TREE_CODE (final) == TREE_VEC)
+ {
+ cond = omp_adjust_neq_condition (TREE_VEC_ELT (final, 1),
+ TREE_OPERAND (incr, 1));
+ gimple_omp_for_set_cond (omp_for, l, cond);
+ continue;
+ }
+
+ omp_adjust_for_condition2 (loc, &cond, &final, index, step);
+
+ gimple_omp_for_set_cond (omp_for, l, cond);
+ if (final == orig_final)
+ continue;
+
+ /* If this is a combined construct, gimplify the final on the
+ outer construct. */
+ if (TREE_CODE (final) != INTEGER_CST
+ && !gimple_omp_for_combined_into_p (omp_for))
+ {
+ tree new_final = create_tmp_var (TREE_TYPE (final));
+ gimplify_assign (new_final, final, pre_body);
+ final = new_final;
+ new_decls = true;
+ }
+
+ gimple_omp_for_set_final (omp_for, l, final);
+ }
+
+ return new_decls;
+}
+
+/* Combined distribute or taskloop constructs are represented by two
+ or more nested gomp_for constructs which are created during
+ gimplification. Loop transformations on the combined construct are
+ executed on the innermost gomp_for. This function adjusts the loop
+ header of an outer OMP_FOR loop to the changes made by the
+ transformations on the inner loop which is provided by the CTX. */
+static gimple_seq
+adjust_combined_loop (gomp_for *omp_for, walk_ctx *ctx)
+{
+ gcc_assert (gimple_omp_for_combined_p (omp_for));
+ gcc_assert (ctx->inner_combined_loop);
+
+ gomp_for *inner_omp_for = ctx->inner_combined_loop;
+ size_t collapse = gimple_omp_for_collapse (inner_omp_for);
+
+ int kind = gimple_omp_for_kind (omp_for);
+ if (kind == GF_OMP_FOR_KIND_DISTRIBUTE || kind == GF_OMP_FOR_KIND_TASKLOOP)
+ {
+ for (size_t level = 0; level < collapse; ++level)
+ {
+ tree outer_incr = gimple_omp_for_incr (omp_for, level);
+ tree inner_incr = gimple_omp_for_incr (inner_omp_for, level);
+ gcc_assert (TREE_TYPE (inner_incr) == TREE_TYPE (outer_incr));
+
+ tree inner_final = gimple_omp_for_final (inner_omp_for, level);
+ enum tree_code inner_cond
+ = gimple_omp_for_cond (inner_omp_for, level);
+ gimple_omp_for_set_cond (omp_for, level, inner_cond);
+
+ tree inner_step = TREE_OPERAND (inner_incr, 1);
+ /* If this omp_for is the outermost loop belonging to a
+ combined construct, gimplify the step into its
+ prebody. Otherwise, just gimplify the step on the inner
+ gomp_for and move the ungimplified step expression
+ here. */
+ if (!gimple_omp_for_combined_into_p (omp_for)
+ && !TREE_CONSTANT (inner_step))
+ {
+ push_gimplify_context ();
+ tree step = create_tmp_var (TREE_TYPE (inner_incr),
+ ".omp_combined_step");
+ gimplify_assign (step, inner_step,
+ gimple_omp_for_pre_body_ptr (omp_for));
+ pop_gimplify_context (ctx->bind);
+ TREE_OPERAND (outer_incr, 1) = step;
+ }
+ else
+ TREE_OPERAND (outer_incr, 1) = inner_step;
+
+ if (!gimple_omp_for_combined_into_p (omp_for)
+ && !TREE_CONSTANT (inner_final))
+ {
+ push_gimplify_context ();
+ tree final = create_tmp_var (TREE_TYPE (inner_final),
+ ".omp_combined_final");
+ gimplify_assign (final, inner_final,
+ gimple_omp_for_pre_body_ptr (omp_for));
+ pop_gimplify_context (ctx->bind);
+ gimple_omp_for_set_final (omp_for, level, final);
+ }
+ else
+ gimple_omp_for_set_final (omp_for, level, inner_final);
+
+ /* Gimplify the step on the inner loop of the combined construct. */
+ if (!TREE_CONSTANT (inner_step))
+ {
+ push_gimplify_context ();
+ tree step = create_tmp_var (TREE_TYPE (inner_incr),
+ ".omp_combined_step");
+ gimplify_assign (step, inner_step,
+ gimple_omp_for_pre_body_ptr (inner_omp_for));
+ TREE_OPERAND (inner_incr, 1) = step;
+ pop_gimplify_context (ctx->bind);
+
+ tree private_clause = build_omp_clause (
+ gimple_location (omp_for), OMP_CLAUSE_PRIVATE);
+ OMP_CLAUSE_DECL (private_clause) = step;
+ tree *clauses = gimple_omp_for_clauses_ptr (inner_omp_for);
+ *clauses = chainon (*clauses, private_clause);
+ }
+
+ /* Gimplify the final on the inner loop of the combined construct. */
+ if (!TREE_CONSTANT (inner_final))
+ {
+ push_gimplify_context ();
+ tree final = create_tmp_var (TREE_TYPE (inner_incr),
+ ".omp_combined_final");
+ gimplify_assign (final, inner_final,
+ gimple_omp_for_pre_body_ptr (inner_omp_for));
+ gimple_omp_for_set_final (inner_omp_for, level, final);
+ pop_gimplify_context (ctx->bind);
+
+ tree private_clause = build_omp_clause (
+ gimple_location (omp_for), OMP_CLAUSE_PRIVATE);
+ OMP_CLAUSE_DECL (private_clause) = final;
+ tree *clauses = gimple_omp_for_clauses_ptr (inner_omp_for);
+ *clauses = chainon (*clauses, private_clause);
+ }
+ }
+ }
+
+ if (gimple_omp_for_combined_into_p (omp_for))
+ ctx->inner_combined_loop = omp_for;
+ else
+ ctx->inner_combined_loop = NULL;
+
+ return omp_for;
+}
+
+/* Transform OMP_FOR recursively according to the clause chain
+ TRANSFORMATION. Return the resulting sequence of gimple statements.
+
+ This function dispatches OMP_FOR to the handler function for the
+ TRANSFORMATION clause. The handler function is responsible for invoking this
+ function recursively for executing the remaining transformations. */
+
+static gimple_seq
+transform_gomp_for (gomp_for *omp_for, tree transformation, walk_ctx *ctx)
+{
+ if (!transformation)
+ {
+ if (gimple_omp_for_kind (omp_for) == GF_OMP_FOR_KIND_TRANSFORM_LOOP)
+ return expand_transformed_loop (omp_for);
+
+ return omp_for;
+ }
+
+ push_gimplify_context ();
+
+ bool added_decls = canonicalize_conditions (omp_for);
+
+ gimple_seq result = NULL;
+ location_t loc = OMP_CLAUSE_LOCATION (transformation);
+ auto dump_loc = dump_user_location_t::from_location_t (loc);
+ switch (OMP_CLAUSE_CODE (transformation))
+ {
+ case OMP_CLAUSE_UNROLL_FULL:
+ gcc_assert (TREE_CHAIN (transformation) == NULL);
+ result = full_unroll (omp_for, loc, ctx);
+ break;
+ case OMP_CLAUSE_UNROLL_NONE:
+ gcc_assert (TREE_CHAIN (transformation) == NULL);
+ if (assign_unroll_full_clause_p (omp_for, transformation))
+ {
+ result = full_unroll (omp_for, loc, ctx);
+ }
+ else if (tree unroll_factor
+ = assign_unroll_partial_clause_p (omp_for, transformation))
+ {
+ result = partial_unroll (omp_for, unroll_factor, loc,
+ transformation, ctx);
+ }
+ else {
+ if (dump_enabled_p ())
+ {
+ /* TODO Try to inform the unrolling pass that the user
+ wants to unroll this loop. This could relax some
+ restrictions there, e.g. on the code size? */
+ dump_printf_loc (
+ MSG_MISSED_OPTIMIZATION, dump_loc,
+ "not unrolling loop with %<omp unroll%> directive. Add "
+ "clause to specify unrolling type or invoke the "
+ "compiler with --param=omp-unroll-default-factor=n for some"
+ "constant integer n");
+ }
+ result = transform_gomp_for (omp_for, NULL, ctx);
+ }
+
+ break;
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ {
+ tree unroll_factor = OMP_CLAUSE_UNROLL_PARTIAL_EXPR (transformation);
+ if (!unroll_factor)
+ {
+ // TODO Use target architecture dependent constants?
+ unsigned factor = param_omp_unroll_default_factor > 0
+ ? param_omp_unroll_default_factor
+ : 5;
+ unroll_factor = build_int_cst (integer_type_node, factor);
+
+ if (dump_enabled_p ())
+ dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, dump_loc,
+ "%<partial%> clause without unrolling "
+ "factor turned into %<partial(%u)%> clause\n",
+ factor);
+ }
+ result = partial_unroll (omp_for, unroll_factor, loc, transformation,
+ ctx);
+ }
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (added_decls && gimple_code (result) != GIMPLE_BIND)
+ result = gimple_build_bind (NULL, result, NULL);
+ pop_gimplify_context (added_decls ? result : NULL); /* for decls from canonicalize_loops */
+
+ return result;
+}
+
+/* Remove all loop transformation clauses from the clauses of OMP_FOR and
+ return a new tree chain containing just those clauses.
+
+ The clauses correspond to transformation *directives* associated with the
+ OMP_FOR's loop. The returned clauses are ordered from the innermost
+ directive to the outermost, i.e. in the order in which the transformations
+ should execute.
+
+ Example:
+ --------
+ --------
+
+ The loop
+
+ #pragma omp for nowait
+ #pragma omp unroll partial(5)
+ #pragma omp tile sizes(2,2)
+ LOOP
+
+ is represented as
+
+ #pragma omp for nowait unroll_partial(5) tile_sizes(2,2)
+ LOOP
+
+ Gimplification may add clauses after the transformation clauses added
+ by the front ends. This function will leave only the "nowait" clause on
+ OMP_FOR and return the clauses "tile_sizes(2,2) unroll_partial(5)". */
+
+static tree
+gomp_for_remove_transformation_clauses (gomp_for *omp_for)
+{
+ tree *clauses = gimple_omp_for_clauses_ptr (omp_for);
+ tree trans_clauses = NULL;
+ tree last_other_clause = NULL;
+
+ for (tree c = gimple_omp_for_clauses (omp_for); c != NULL_TREE;)
+ {
+ tree chain_tail = OMP_CLAUSE_CHAIN (c);
+ if (omp_loop_transform_clause_p (c))
+ {
+ if (last_other_clause)
+ OMP_CLAUSE_CHAIN (last_other_clause) = chain_tail;
+ else
+ *clauses = OMP_CLAUSE_CHAIN (c);
+
+ OMP_CLAUSE_CHAIN (c) = NULL;
+ trans_clauses = chainon (trans_clauses, c);
+ }
+ else
+ {
+ /* There should be no other clauses between loop transformations ... */
+ gcc_assert (!trans_clauses || !last_other_clause
+ || TREE_CHAIN (last_other_clause) == c);
+ /* ... and hence stop if transformations were found before the
+ non-transformation clause C. */
+ if (trans_clauses)
+ break;
+ last_other_clause = c;
+ }
+
+ c = chain_tail;
+ }
+
+ return nreverse (trans_clauses);
+}
+
+static void
+print_optimized_unroll_partial_msg (tree c)
+{
+ gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_UNROLL_PARTIAL);
+ location_t loc = OMP_CLAUSE_LOCATION (c);
+ dump_user_location_t dump_loc;
+ dump_loc = dump_user_location_t::from_location_t (loc);
+
+ tree unroll_factor = OMP_CLAUSE_UNROLL_PARTIAL_EXPR (c);
+ dump_printf_loc (MSG_OPTIMIZED_LOCATIONS, dump_loc,
+ "replaced consecutive %<omp unroll%> directives by "
+ "%<omp unroll auto(" HOST_WIDE_INT_PRINT_UNSIGNED
+ ")%>\n", tree_to_uhwi (unroll_factor));
+}
+
+/* Optimize CLAUSES by removing and merging redundant clauses. Return the
+ optimized clause chain. */
+
+static tree
+optimize_transformation_clauses (tree clauses)
+{
+ /* The last unroll_partial clause seen in clauses, if any,
+ or the last merged unroll partial clause. */
+ tree unroll_partial = NULL;
+ /* The last clause was not a unroll_partial clause, if any.
+ unroll_full and unroll_none are not relevant because
+ they appear only at the end of a chain. */
+ tree last_non_unroll = NULL;
+ /* Indicates that at least two unroll_partial clauses have been merged
+ since last_non_unroll was seen. */
+ bool merged_unroll_partial = false;
+
+ for (tree c = clauses; c != NULL_TREE; c = OMP_CLAUSE_CHAIN (c))
+ {
+ enum omp_clause_code code = OMP_CLAUSE_CODE (c);
+
+ switch (code)
+ {
+ case OMP_CLAUSE_UNROLL_NONE:
+ /* 'unroll' without a clause cannot be followed by any
+ transformations because its result does not have canonical loop
+ nest form. */
+ gcc_assert (OMP_CLAUSE_CHAIN (c) == NULL);
+ unroll_partial = NULL;
+ merged_unroll_partial = false;
+ break;
+ case OMP_CLAUSE_UNROLL_FULL:
+ /* 'unroll full' cannot be followed by any transformations because
+ its result does not have canonical loop nest form. */
+ gcc_assert (OMP_CLAUSE_CHAIN (c) == NULL);
+
+ /* Previous 'unroll partial' directives are useless. */
+ if (unroll_partial)
+ {
+ if (last_non_unroll)
+ OMP_CLAUSE_CHAIN (last_non_unroll) = c;
+ else
+ clauses = c;
+
+ if (dump_enabled_p ())
+ {
+ location_t loc = OMP_CLAUSE_LOCATION (c);
+ dump_user_location_t dump_loc;
+ dump_loc = dump_user_location_t::from_location_t (loc);
+
+ dump_printf_loc (
+ MSG_OPTIMIZED_LOCATIONS, dump_loc,
+ "removed useless %<omp unroll auto%> directives "
+ "preceding 'omp unroll full'\n");
+ }
+ }
+ unroll_partial = NULL;
+ merged_unroll_partial = false;
+ break;
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ {
+ /* Merge a sequence of consecutive 'unroll partial' directives.
+ Note that it impossible for 'unroll full' or 'unroll' to
+ appear inbetween the 'unroll partial' clauses because they
+ remove the loop-nest. */
+ if (unroll_partial)
+ {
+ tree factor = OMP_CLAUSE_UNROLL_PARTIAL_EXPR (unroll_partial);
+ tree c_factor = OMP_CLAUSE_UNROLL_PARTIAL_EXPR (c);
+ if (factor && c_factor)
+ factor = fold_build2 (MULT_EXPR, TREE_TYPE (factor), factor,
+ c_factor);
+ else if (!factor && c_factor)
+ factor = c_factor;
+
+ gcc_assert (!factor || TREE_CODE (factor) == INTEGER_CST);
+
+ OMP_CLAUSE_UNROLL_PARTIAL_EXPR (unroll_partial) = factor;
+ OMP_CLAUSE_CHAIN (unroll_partial) = OMP_CLAUSE_CHAIN (c);
+ OMP_CLAUSE_LOCATION (unroll_partial) = OMP_CLAUSE_LOCATION (c);
+ merged_unroll_partial = true;
+ }
+ else
+ unroll_partial = c;
+ }
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ }
+
+ if (merged_unroll_partial && dump_enabled_p ())
+ print_optimized_unroll_partial_msg (unroll_partial);
+
+ return clauses;
+}
+
+/* Visit the current statement in GSI_P in the walk_omp_for_loops walk and
+ execute all loop transformations found on it. */
+
+void
+process_omp_for (gomp_for *omp_for, gimple_seq *containing_seq, walk_ctx *ctx)
+{
+ auto gsi_p = gsi_for_stmt (omp_for, containing_seq);
+ tree transform_clauses = gomp_for_remove_transformation_clauses (omp_for);
+
+ /* Do not attempt to transform broken code which might violate the
+ assumptions of the loop transformation implementations.
+
+ Transformation clauses must be dropped first because following
+ passes do not handle them. */
+ if (seen_error ())
+ return;
+
+ transform_clauses = optimize_transformation_clauses (transform_clauses);
+
+ gimple *transformed = omp_for;
+ if (gimple_omp_for_combined_p (omp_for)
+ && ctx->inner_combined_loop)
+ transformed = adjust_combined_loop (omp_for, ctx);
+ else
+ transformed = transform_gomp_for (omp_for, transform_clauses, ctx);
+
+ if (transformed == omp_for)
+ return;
+
+ gsi_replace_with_seq (&gsi_p, transformed, true);
+
+ if (!dump_enabled_p () || !(dump_flags & TDF_DETAILS))
+ return;
+
+ dump_printf_loc (MSG_NOTE | MSG_PRIORITY_INTERNALS, transformed,
+ "Transformed loop: %G\n\n", transformed);
+}
+
+/* Traverse SEQ in depth-first order and apply the loop transformation
+ found on gomp_for statements. */
+
+static unsigned int
+walk_omp_for_loops (gimple_seq *seq, walk_ctx *ctx)
+{
+ gimple_stmt_iterator gsi;
+ for (gsi = gsi_start (*seq); !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple *stmt = gsi_stmt (gsi);
+ switch (gimple_code (stmt))
+ {
+ case GIMPLE_OMP_CRITICAL:
+ case GIMPLE_OMP_MASTER:
+ case GIMPLE_OMP_MASKED:
+ case GIMPLE_OMP_TASKGROUP:
+ case GIMPLE_OMP_ORDERED:
+ case GIMPLE_OMP_SCAN:
+ case GIMPLE_OMP_SECTION:
+ case GIMPLE_OMP_PARALLEL:
+ case GIMPLE_OMP_TASK:
+ case GIMPLE_OMP_SCOPE:
+ case GIMPLE_OMP_SECTIONS:
+ case GIMPLE_OMP_SINGLE:
+ case GIMPLE_OMP_TARGET:
+ case GIMPLE_OMP_TEAMS:
+ {
+ gbind *bind = ctx->bind;
+ walk_omp_for_loops (gimple_omp_body_ptr (stmt), ctx);
+ ctx->bind = bind;
+ break;
+ }
+ case GIMPLE_OMP_FOR:
+ {
+ gbind *bind = ctx->bind;
+ walk_omp_for_loops (gimple_omp_for_pre_body_ptr (stmt), ctx);
+ walk_omp_for_loops (gimple_omp_body_ptr (stmt), ctx);
+ ctx->bind = bind;
+ process_omp_for (as_a<gomp_for *> (stmt), seq, ctx);
+ break;
+ }
+ case GIMPLE_BIND:
+ {
+ gbind *bind = as_a<gbind *> (stmt);
+ ctx->bind = bind;
+ walk_omp_for_loops (gimple_bind_body_ptr (bind), ctx);
+ ctx->bind = bind;
+ break;
+ }
+ case GIMPLE_TRY:
+ {
+ gbind *bind = ctx->bind;
+ walk_omp_for_loops (gimple_try_eval_ptr (as_a<gtry *> (stmt)),
+ ctx);
+ walk_omp_for_loops (gimple_try_cleanup_ptr (as_a<gtry *> (stmt)),
+ ctx);
+ ctx->bind = bind;
+ break;
+ }
+
+ case GIMPLE_CATCH:
+ {
+ gbind *bind = ctx->bind;
+ walk_omp_for_loops (
+ gimple_catch_handler_ptr (as_a<gcatch *> (stmt)), ctx);
+ ctx->bind = bind;
+ break;
+ }
+
+ case GIMPLE_EH_FILTER:
+ {
+ gbind *bind = ctx->bind;
+ walk_omp_for_loops (gimple_eh_filter_failure_ptr (stmt), ctx);
+ ctx->bind = bind;
+ break;
+ }
+
+ case GIMPLE_EH_ELSE:
+ {
+ gbind *bind = ctx->bind;
+ geh_else *eh_else_stmt = as_a<geh_else *> (stmt);
+ walk_omp_for_loops (gimple_eh_else_n_body_ptr (eh_else_stmt), ctx);
+ walk_omp_for_loops (gimple_eh_else_e_body_ptr (eh_else_stmt), ctx);
+ ctx->bind = bind;
+ break;
+ }
+ break;
+
+ case GIMPLE_WITH_CLEANUP_EXPR:
+ {
+ gbind *bind = ctx->bind;
+ walk_omp_for_loops (gimple_wce_cleanup_ptr (stmt), ctx);
+ ctx->bind = bind;
+ break;
+ }
+
+ case GIMPLE_TRANSACTION:
+ {
+ gbind *bind = ctx->bind;
+ auto trans = as_a<gtransaction *> (stmt);
+ walk_omp_for_loops (gimple_transaction_body_ptr (trans), ctx);
+ ctx->bind = bind;
+ break;
+ }
+
+ default:
+ gcc_assert (!gimple_has_substatements (stmt));
+ continue;
+ }
+ }
+
+ return true;
+}
+
+static unsigned int
+execute_omp_transform_loops ()
+{
+ gimple_seq body = gimple_body (current_function_decl);
+ walk_ctx ctx;
+ ctx.inner_combined_loop = NULL;
+ ctx.bind = NULL;
+ walk_omp_for_loops (&body, &ctx);
+
+ return 0;
+}
+
+namespace
+{
+
+const pass_data pass_data_omp_transform_loops = {
+ GIMPLE_PASS, /* type */
+ "omp_transform_loops", /* name */
+ OPTGROUP_OMP, /* optinfo_flags */
+ TV_NONE, /* tv_id */
+ PROP_gimple_any, /* properties_required */
+ 0, /* properties_provided */
+ 0, /* properties_destroyed */
+ 0, /* todo_flags_start */
+ 0, /* todo_flags_finish */
+};
+
+class pass_omp_transform_loops : public gimple_opt_pass
+{
+public:
+ pass_omp_transform_loops (gcc::context *ctxt)
+ : gimple_opt_pass (pass_data_omp_transform_loops, ctxt)
+ {
+ }
+
+ /* opt_pass methods: */
+ virtual unsigned int
+ execute (function *)
+ {
+ return execute_omp_transform_loops ();
+ }
+ virtual bool
+ gate (function *)
+ {
+ return flag_openmp || flag_openmp_simd;
+ }
+
+}; // class pass_omp_transform_loops
+
+} // anon namespace
+
+gimple_opt_pass *
+make_pass_omp_transform_loops (gcc::context *ctxt)
+{
+ return new pass_omp_transform_loops (ctxt);
+}
diff --git a/gcc/params.opt b/gcc/params.opt
index f7e900fe519..d3999261e53 100644
--- a/gcc/params.opt
+++ b/gcc/params.opt
@@ -834,6 +834,15 @@ Enum(openacc_privatization) String(quiet) Value(OPENACC_PRIVATIZATION_QUIET)
EnumValue
Enum(openacc_privatization) String(noisy) Value(OPENACC_PRIVATIZATION_NOISY)
+-param=omp-unroll-full-max-iterations=
+Common Joined UInteger Var(param_omp_unroll_full_max_iterations) Init(5) Param Optimization
+The maximum number of iterations of a loop for which an 'omp unroll' directive on the loop without a
+clause will be turned into an 'omp unroll full'.
+
+-param=omp-unroll-default-factor=
+Common Joined UInteger Var(param_omp_unroll_default_factor) Init(0) Param Optimization
+The unroll factor that will be used for loops that have an 'omp unroll partial' directive without an explicit unroll factor.
+
-param=parloops-chunk-size=
Common Joined UInteger Var(param_parloops_chunk_size) Param Optimization
Chunk size of omp schedule for loops parallelized by parloops.
diff --git a/gcc/passes.def b/gcc/passes.def
index 8801e4f59fd..96a38d8d5f0 100644
--- a/gcc/passes.def
+++ b/gcc/passes.def
@@ -36,6 +36,7 @@ along with GCC; see the file COPYING3. If not see
NEXT_PASS (pass_diagnose_tm_blocks);
NEXT_PASS (pass_omp_data_optimize);
NEXT_PASS (pass_omp_oacc_kernels_decompose);
+ NEXT_PASS (pass_omp_transform_loops);
NEXT_PASS (pass_lower_omp);
NEXT_PASS (pass_usm_transform);
NEXT_PASS (pass_lower_cf);
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-1.f90
new file mode 100644
index 00000000000..4cfac4c5e26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-1.f90
@@ -0,0 +1,277 @@
+subroutine test1
+ implicit none
+ integer :: i
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+subroutine test2
+ implicit none
+ integer :: i
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test2
+
+subroutine test3
+ implicit none
+ integer :: i
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end do
+end subroutine test3
+
+subroutine test4
+ implicit none
+ integer :: i
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end do
+end subroutine test4
+
+subroutine test5
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test5
+
+subroutine test6
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test6
+
+subroutine test7
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test7
+
+subroutine test8
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end unroll
+end subroutine test8
+
+subroutine test9
+ implicit none
+ integer :: i
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test9
+
+subroutine test10
+ implicit none
+ integer :: i
+
+ !$omp unroll full ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test10
+
+subroutine test11
+ implicit none
+ integer :: i,j
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ do j = 1,100
+ call dummy2(i,j)
+ end do
+ end do
+end subroutine test11
+
+subroutine test12
+ implicit none
+ integer :: i,j
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ call dummy(i) ! { dg-error {Unexpected CALL statement at \(1\)} }
+ !$omp unroll
+ do j = 1,100
+ call dummy2(i,j)
+ end do
+ end do
+end subroutine test12
+
+subroutine test13
+ implicit none
+ integer :: i,j
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do j = 1,100
+ call dummy2(i,j)
+ end do
+ call dummy(i)
+ end do
+end subroutine test13
+
+subroutine test14
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end unroll
+ !$omp end unroll ! { dg-error {Unexpected \!\$OMP END UNROLL statement at \(1\)} }
+end subroutine test14
+
+subroutine test15
+ implicit none
+ integer :: i
+
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end unroll
+ !$omp end unroll ! { dg-error {Unexpected \!\$OMP END UNROLL statement at \(1\)} }
+end subroutine test15
+
+subroutine test16
+ implicit none
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(1)
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test16
+
+subroutine test17
+ implicit none
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(2)
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test17
+
+subroutine test18
+ implicit none
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(0) ! { dg-error {PARTIAL clause argument not constant positive integer at \(1\)} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test18
+
+subroutine test19
+ implicit none
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(-10) ! { dg-error {PARTIAL clause argument not constant positive integer at \(1\)} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test19
+
+subroutine test20
+ implicit none
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test20
+
+subroutine test21
+ implicit none
+ integer :: i
+
+ !$omp unroll partial ! { dg-error {\!\$OMP UNROLL invalid around DO CONCURRENT loop at \(1\)} }
+ do concurrent (i = 1:100)
+ call dummy(i) ! { dg-error {Subroutine call to 'dummy' in DO CONCURRENT block at \(1\) is not PURE} }
+ end do
+ !$omp end unroll
+end subroutine test21
+
+subroutine test22
+ implicit none
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial
+ do concurrent (i = 1:100) ! { dg-error {\!\$OMP DO cannot be a DO CONCURRENT loop at \(1\)} }
+ call dummy(i) ! { dg-error {Subroutine call to 'dummy' in DO CONCURRENT block at \(1\) is not PURE} }
+ end do
+ !$omp end unroll
+end subroutine test22
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-10.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-10.f90
new file mode 100644
index 00000000000..2c4a45d3054
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-10.f90
@@ -0,0 +1,7 @@
+subroutine test(i)
+ ! TODO The checking that produces this message comes too late. Not important, but would be nice to have.
+ !$omp unroll full ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} "" { xfail *-*-* } }
+ call dummy0 ! { dg-error {Unexpected CALL statement at \(1\)} }
+end subroutine test ! { dg-error {Unexpected END statement at \(1\)} }
+
+! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-11.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-11.f90
new file mode 100644
index 00000000000..3f0d5981e9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-11.f90
@@ -0,0 +1,75 @@
+subroutine test1(i)
+ implicit none
+ integer :: i
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test1
+
+subroutine test2(i)
+ implicit none
+ integer :: i
+ !$omp unroll full ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test2
+
+subroutine test3(i)
+ implicit none
+ integer :: i
+ !$omp unroll full ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll full
+ !$omp unroll
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test3
+
+subroutine test4(i)
+ implicit none
+ integer :: i
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test4
+
+subroutine test5(i)
+ implicit none
+ integer :: i
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test5
+
+subroutine test6(i)
+ implicit none
+ integer :: i
+ !$omp do ! { dg-error {missing canonical loop nest after \!\$OMP DO at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test6
+
+subroutine test7(i)
+ implicit none
+ integer :: i
+ !$omp loop ! { dg-error {missing canonical loop nest after \!\$OMP LOOP at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test7
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-12.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-12.f90
new file mode 100644
index 00000000000..0d8f3f5a2c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-12.f90
@@ -0,0 +1,29 @@
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll ! { dg-error {\!\$OMP UNROLL invalid around DO WHILE or DO without loop control at \(1\)} }
+ do while (i < 10)
+ call dummy(i)
+ i = i + 1
+ end do
+end subroutine test1
+
+subroutine test2
+ implicit none
+ integer :: i
+ !$omp unroll ! { dg-error {\!\$OMP UNROLL invalid around DO WHILE or DO without loop control at \(1\)} }
+ do
+ call dummy(i)
+ i = i + 1
+ if (i >= 10) exit
+ end do
+end subroutine test2
+
+subroutine test3
+ implicit none
+ integer :: i
+ !$omp unroll ! { dg-error {\!\$OMP UNROLL invalid around DO CONCURRENT loop at \(1\)} }
+ do concurrent (i=1:10)
+ call dummy(i) ! { dg-error {Subroutine call to 'dummy' in DO CONCURRENT block at \(1\) is not PURE} }
+ end do
+end subroutine test3
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-2.f90
new file mode 100644
index 00000000000..8496f9eefe0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-2.f90
@@ -0,0 +1,22 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test1
+
+subroutine test2
+ implicit none
+ integer :: i
+ !$omp unroll full
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test2
+
+! { dg-final { scan-tree-dump-times "#pragma omp loop_transform unroll_none" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp loop_transform unroll_full" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-3.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-3.f90
new file mode 100644
index 00000000000..0d233c9ab6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-3.f90
@@ -0,0 +1,17 @@
+! { dg-additional-options "-fdump-tree-omp_transform_loops" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll full
+ do i = 1,10
+ call dummy(i)
+ end do
+end subroutine test1
+
+! Loop should be removed with 10 copies of the body remaining
+
+! { dg-final { scan-tree-dump-times "dummy" 10 "omp_transform_loops" } }
+! { dg-final { scan-tree-dump "#pragma omp loop_transform" "original" } }
+! { dg-final { scan-tree-dump-not "#pragma omp" "omp_transform_loops" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-4.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-4.f90
new file mode 100644
index 00000000000..fcccdb0bcf8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-4.f90
@@ -0,0 +1,18 @@
+! { dg-additional-options "-fdump-tree-omp_transform_loops" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+! Loop should not be unrolled, but the internal representation should be lowered
+
+! { dg-final { scan-tree-dump "#pragma omp loop_transform" "original" } }
+! { dg-final { scan-tree-dump-not "#pragma omp" "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times "dummy" 1 "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times {if \(i\.[0-9]+ < .+?.+goto.+else goto.*?$} 1 "omp_transform_loops" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-5.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-5.f90
new file mode 100644
index 00000000000..ee82b4d150c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-5.f90
@@ -0,0 +1,18 @@
+! { dg-additional-options "-fdump-tree-omp_transform_loops -fopt-info-omp-optimized-missed" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll partial ! { dg-optimized {'partial' clause without unrolling factor turned into 'partial\(5\)' clause} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+! Loop should be unrolled 5 times and the internal representation should be lowered.
+
+! { dg-final { scan-tree-dump {#pragma omp loop_transform unroll_partial} "original" } }
+! { dg-final { scan-tree-dump-not "#pragma omp" "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times "dummy" 5 "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times {if \(i\.[0-9]+ < .+?.+goto.+else goto.*?$} 1 "omp_transform_loops" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-6.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-6.f90
new file mode 100644
index 00000000000..237e6b83087
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-6.f90
@@ -0,0 +1,19 @@
+! { dg-additional-options "--param=omp-unroll-default-factor=10" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops -fopt-info-omp-optimized-missed" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll partial ! { dg-optimized {'partial' clause without unrolling factor turned into 'partial\(10\)' clause} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+! Loop should be unrolled 10 times and the internal representation should be lowered.
+
+! { dg-final { scan-tree-dump {#pragma omp loop_transform unroll_partial} "original" } }
+! { dg-final { scan-tree-dump-not "#pragma omp" "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times "dummy" 10 "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times {if \(i\.[0-9]+ < .+?.+goto.+else goto.*?$} 1 "omp_transform_loops" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-7.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-7.f90
new file mode 100644
index 00000000000..8feaf7dc4d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-7.f90
@@ -0,0 +1,62 @@
+! { dg-additional-options "--param=omp-unroll-default-factor=10" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops -fopt-info-omp-optimized-missed" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i,j
+ !$omp parallel do
+ !$omp unroll partial(10)
+ do i = 1,100
+ !$omp parallel do
+ do j = 1,100
+ call dummy(i,j)
+ end do
+ end do
+
+ !$omp taskloop
+ !$omp unroll partial(10)
+ do i = 1,100
+ !$omp parallel do
+ do j = 1,100
+ call dummy(i,j)
+ end do
+ end do
+
+end subroutine test1
+
+! For the "parallel do", there should be 11 "omp for" loops, 10 for the inner loop, 1 for outer,
+! for the "taskloop", there should be 10 "omp for" loops for the unrolled loop
+! { dg-final { scan-tree-dump-times {#pragma omp for} 21 "omp_transform_loops" } }
+! ... and two outer taskloops plus the one taskloops
+! { dg-final { scan-tree-dump-times {#pragma omp taskloop} 3 "omp_transform_loops" } }
+
+
+subroutine test2
+ implicit none
+ integer :: i,j
+ do i = 1,100
+ !$omp teams distribute
+ !$omp unroll partial(10)
+ do j = 1,100
+ call dummy(i,j)
+ end do
+ end do
+
+ do i = 1,100
+ !$omp target teams distribute
+ !$omp unroll partial(10)
+ do j = 1,100
+ call dummy(i,j)
+ end do
+ end do
+end subroutine test2
+
+! { dg-final { scan-tree-dump-times {#pragma omp distribute} 2 "omp_transform_loops" } }
+
+! After unrolling there should be 10 copies of each loop body for each loop-nest
+! { dg-final { scan-tree-dump-times "dummy" 40 "omp_transform_loops" } }
+
+! { dg-final { scan-tree-dump-not {#pragma omp loop_transform} "original" } }
+! { dg-final { scan-tree-dump-times {#pragma omp for nowait unroll_partial\(10\)} 1 "original" } }
+! { dg-final { scan-tree-dump-times {#pragma omp distribute private\(j\) unroll_partial\(10\)} 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-8.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-8.f90
new file mode 100644
index 00000000000..9b91e5c5f98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-8.f90
@@ -0,0 +1,22 @@
+! { dg-additional-options "-fdump-tree-omp_transform_loops -fopt-info-omp-optimized-missed" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp parallel do collapse(1)
+ !$omp unroll partial(4) ! { dg-optimized {replaced consecutive 'omp unroll' directives by 'omp unroll auto\(24\)'} }
+ !$omp unroll partial(3)
+ !$omp unroll partial(2)
+ !$omp unroll partial(1)
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+! Loop should be unrolled 1 * 2 * 3 * 4 = 24 times
+
+! { dg-final { scan-tree-dump {#pragma omp for nowait collapse\(1\) unroll_partial\(4\) unroll_partial\(3\) unroll_partial\(2\) unroll_partial\(1\)} "original" } }
+! { dg-final { scan-tree-dump-not "#pragma omp loop_transform" "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times "dummy" 24 "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times {#pragma omp for} 1 "omp_transform_loops" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-9.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-9.f90
new file mode 100644
index 00000000000..849d4e77984
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-9.f90
@@ -0,0 +1,18 @@
+! { dg-additional-options "-fdump-tree-omp_transform_loops -fopt-info-omp-optimized-missed" }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine test1
+ implicit none
+ integer :: i
+ !$omp unroll full ! { dg-optimized {removed useless 'omp unroll auto' directives preceding 'omp unroll full'} }
+ !$omp unroll partial(3)
+ !$omp unroll partial(2)
+ !$omp unroll partial(1)
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+! { dg-final { scan-tree-dump {#pragma omp loop_transform unroll_full unroll_partial\(3\) unroll_partial\(2\) unroll_partial\(1\)} "original" } }
+! { dg-final { scan-tree-dump-not "#pragma omp unroll" "omp_transform_loops" } }
+! { dg-final { scan-tree-dump-times "dummy" 100 "omp_transform_loops" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-1.f90
new file mode 100644
index 00000000000..079c0fdd75b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-1.f90
@@ -0,0 +1,20 @@
+! { dg-additional-options "-fopt-info-optimized -fdump-tree-omp_transform_loops-details" }
+
+subroutine test
+ !$omp unroll ! { dg-optimized {assigned 'full' clause to 'omp unroll' with small constant number of iterations} }
+ do i = 1,5
+ do j = 1,10
+ call dummy3(i,j)
+ end do
+ end do
+ !$omp end unroll
+
+ !$omp unroll
+ do i = 1,6
+ do j = 1,6
+ call dummy3(i,j)
+ end do
+ end do
+ !$omp end unroll
+end subroutine test
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-2.f90
new file mode 100644
index 00000000000..4893ba46e4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-2.f90
@@ -0,0 +1,21 @@
+! { dg-additional-options "--param=omp-unroll-full-max-iterations=20" }
+! { dg-additional-options "-fopt-info-optimized -fdump-tree-omp_transform_loops-details" }
+
+subroutine test
+ !$omp unroll ! { dg-optimized {assigned 'full' clause to 'omp unroll' with small constant number of iterations} }
+ do i = 1,20
+ do j = 1,10
+ call dummy3(i,j)
+ end do
+ end do
+ !$omp end unroll
+
+ !$omp unroll
+ do i = 1,21
+ do j = 1,6
+ call dummy3(i,j)
+ end do
+ end do
+ !$omp end unroll
+end subroutine test
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-3.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-3.f90
new file mode 100644
index 00000000000..60f25d3abe6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-no-clause-3.f90
@@ -0,0 +1,23 @@
+! { dg-additional-options "--param=omp-unroll-full-max-iterations=10" }
+! { dg-additional-options "--param=omp-unroll-default-factor=10" }
+! { dg-additional-options "-fopt-info-optimized -fdump-tree-omp_transform_loops-details" }
+
+subroutine test
+ !$omp unroll ! { dg-optimized {added 'partial\(10\)' clause to 'omp unroll' directive} }
+ do i = 1,20
+ do j = 1,10
+ call dummy3(i,j)
+ end do
+ end do
+ !$omp end unroll
+
+ !$omp unroll ! { dg-optimized {added 'partial\(10\)' clause to 'omp unroll' directive} }
+ do i = 1,21
+ !$omp unroll ! { dg-optimized {assigned 'full' clause to 'omp unroll' with small constant number of iterations} }
+ do j = 1,6
+ call dummy3(i,j)
+ end do
+ end do
+ !$omp end unroll
+end subroutine test
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-1.f90
new file mode 100644
index 00000000000..f22debbb78f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-1.f90
@@ -0,0 +1,244 @@
+! { dg-options "-fno-openmp -fopenmp-simd" }
+
+subroutine test1
+ implicit none
+ integer :: i
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test1
+
+subroutine test2
+ implicit none
+ integer :: i
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test2
+
+subroutine test3
+ implicit none
+ integer :: i
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end do
+end subroutine test3
+
+subroutine test4
+ implicit none
+ integer :: i
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end do
+end subroutine test4
+
+subroutine test5
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test5
+
+subroutine test6
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test6
+
+subroutine test7
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end unroll
+end subroutine test7
+
+subroutine test8
+ implicit none
+ integer :: i
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test8
+
+subroutine test9
+ implicit none
+ integer :: i
+
+ !$omp unroll full ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll full ! { dg-warning {\!\$OMP UNROLL with FULL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+end subroutine test9
+
+subroutine test10
+ implicit none
+ integer :: i,j
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ do j = 1,100
+ call dummy2(i,j)
+ end do
+ end do
+end subroutine test10
+
+subroutine test11
+ implicit none
+ integer :: i,j
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ call dummy(i) ! { dg-error {Unexpected CALL statement at \(1\)} }
+ !$omp unroll
+ do j = 1,100
+ call dummy2(i,j)
+ end do
+ end do
+end subroutine test11
+
+subroutine test12
+ implicit none
+ integer :: i,j
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do j = 1,100
+ call dummy2(i,j)
+ end do
+ call dummy(i)
+ end do
+end subroutine test12
+
+subroutine test13
+ implicit none
+ integer :: i
+
+ !$omp unroll ! { dg-error {missing canonical loop nest after \!\$OMP UNROLL at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end unroll
+ !$omp end unroll ! { dg-error {Unexpected \!\$OMP END UNROLL statement at \(1\)} }
+end subroutine test13
+
+subroutine test14
+ implicit none
+ integer :: i
+
+ !$omp simd ! { dg-error {missing canonical loop nest after \!\$OMP SIMD at \(1\)} }
+ !$omp unroll ! { dg-warning {\!\$OMP UNROLL without PARTIAL clause at \(1\) turns loop into a non-loop} }
+ !$omp unroll
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+ !$omp end unroll
+ !$omp end unroll ! { dg-error {Unexpected \!\$OMP END UNROLL statement at \(1\)} }
+end subroutine test14
+
+subroutine test15
+ implicit none
+ integer :: i
+
+ !$omp simd
+ !$omp unroll partial(1)
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test15
+
+subroutine test16
+ implicit none
+ integer :: i
+
+ !$omp simd
+ !$omp unroll partial(2)
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test16
+
+subroutine test17
+ implicit none
+ integer :: i
+
+ !$omp simd
+ !$omp unroll partial(0) ! { dg-error {PARTIAL clause argument not constant positive integer at \(1\)} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test17
+
+subroutine test18
+ implicit none
+ integer :: i
+
+ !$omp simd
+ !$omp unroll partial(-10) ! { dg-error {PARTIAL clause argument not constant positive integer at \(1\)} }
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test18
+
+subroutine test19
+ implicit none
+ integer :: i
+
+ !$omp simd
+ !$omp unroll partial
+ do i = 1,100
+ call dummy(i)
+ end do
+ !$omp end unroll
+end subroutine test19
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-2.f90
new file mode 100644
index 00000000000..faaa37c5d7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/unroll-simd-2.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-O2 -fopenmp-simd" }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops" }
+
+module test_functions
+ contains
+ integer function compute_sum() result(sum)
+ implicit none
+
+ integer :: i,j
+
+ !$omp simd
+ do i = 1,10,3
+ !$omp unroll full
+ do j = 1,10,3
+ sum = sum + 1
+ end do
+ end do
+ end function
+
+ integer function compute_sum2() result(sum)
+ implicit none
+
+ integer :: i,j
+
+ !$omp simd
+ !$omp unroll partial(2)
+ do i = 1,10,3
+ do j = 1,10,3
+ sum = sum + 1
+ end do
+ end do
+ end function
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum ()
+ write (*,*) result
+ if (result .ne. 16) then
+ call abort
+ end if
+
+ result = compute_sum2 ()
+ write (*,*) result
+ if (result .ne. 16) then
+ call abort
+ end if
+end program
+
+! { dg-final { scan-tree-dump {omp loop_transform} "original" } }
+! { dg-final { scan-tree-dump-not {omp loop_transform} "omp_transform_loops" } }
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index f57c9e088f1..a10b9219573 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -533,6 +533,15 @@ enum omp_clause_code {
/* OpenMP clause: uses_allocators. */
OMP_CLAUSE_USES_ALLOCATORS,
+
+ /* Internal representation for an "omp unroll full" directive. */
+ OMP_CLAUSE_UNROLL_FULL,
+
+ /* Internal representation for an "omp unroll" directive without a clause. */
+ OMP_CLAUSE_UNROLL_NONE,
+
+ /* Internal representation for an "omp unroll partial" directive. */
+ OMP_CLAUSE_UNROLL_PARTIAL,
};
#undef DEFTREESTRUCT
diff --git a/gcc/tree-pass.h b/gcc/tree-pass.h
index db0a6dbb79a..66ae7e9a4d2 100644
--- a/gcc/tree-pass.h
+++ b/gcc/tree-pass.h
@@ -423,6 +423,7 @@ extern gimple_opt_pass *make_pass_lower_vector (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_lower_vector_ssa (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_omp_oacc_kernels_decompose (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_omp_expand_metadirective (gcc::context *ctxt);
+extern gimple_opt_pass *make_pass_omp_transform_loops (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_lower_omp (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_omp_data_optimize (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_diagnose_omp_blocks (gcc::context *ctxt);
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index 98a9ea4d5a1..f00486e1b9e 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -505,6 +505,22 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
case OMP_CLAUSE_EXCLUSIVE:
name = "exclusive";
goto print_remap;
+ case OMP_CLAUSE_UNROLL_FULL:
+ pp_string (pp, "unroll_full");
+ break;
+ case OMP_CLAUSE_UNROLL_NONE:
+ pp_string (pp, "unroll_none");
+ break;
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ pp_string (pp, "unroll_partial");
+ if (OMP_CLAUSE_UNROLL_PARTIAL_EXPR (clause))
+ {
+ pp_left_paren (pp);
+ dump_generic_node (pp, OMP_CLAUSE_UNROLL_PARTIAL_EXPR (clause), spc, flags,
+ false);
+ pp_right_paren (pp);
+ }
+ break;
case OMP_CLAUSE__LOOPTEMP_:
name = "_looptemp_";
goto print_remap;
@@ -3695,6 +3711,10 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
pp_string (pp, "#pragma omp distribute");
goto dump_omp_loop;
+ case OMP_LOOP_TRANS:
+ pp_string (pp, "#pragma omp loop_transform");
+ goto dump_omp_loop;
+
case OMP_TASKLOOP:
pp_string (pp, "#pragma omp taskloop");
goto dump_omp_loop;
diff --git a/gcc/tree.cc b/gcc/tree.cc
index 504b8378bba..5dd514d99f1 100644
--- a/gcc/tree.cc
+++ b/gcc/tree.cc
@@ -352,6 +352,9 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_NOHOST */
2, /* OMP_CLAUSE_ALLOCATOR */
3, /* OMP_CLAUSE_USES_ALLOCATORS */
+ 0, /* OMP_CLAUSE_UNROLL_FULL */
+ 0, /* OMP_CLAUSE_UNROLL_NONE */
+ 1, /* OMP_CLAUSE_UNROLL_PARTIAL */
};
const char * const omp_clause_code_name[] =
@@ -445,6 +448,9 @@ const char * const omp_clause_code_name[] =
"nohost",
"allocator",
"uses_allocators",
+ "unroll_full",
+ "unroll_none",
+ "unroll_partial",
};
/* Unless specific to OpenACC, we tend to internally maintain OpenMP-centric
diff --git a/gcc/tree.def b/gcc/tree.def
index eb4a100e736..32e3032b7f1 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1163,6 +1163,12 @@ DEFTREECODE (OMP_TASK, "omp_task", tcc_statement, 2)
unspecified by the standards. */
DEFTREECODE (OMP_FOR, "omp_for", tcc_statement, 7)
+/* OpenMP - A loop nest to which a loop transformation such as #pragma omp
+ unroll should be applied, but which is not associated with another directive
+ such as #pragma omp for. The kind of loop transformations to be applied are
+ internally represented by clauses. Operands like for OMP_FOR. */
+DEFTREECODE (OMP_LOOP_TRANS, "omp_loop_trans", tcc_statement, 7)
+
/* OpenMP - #pragma omp simd [clause1 ... clauseN]
Operands like for OMP_FOR. */
DEFTREECODE (OMP_SIMD, "omp_simd", tcc_statement, 7)
diff --git a/gcc/tree.h b/gcc/tree.h
index 3148dee8aa4..dd8ee9f2740 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1743,6 +1743,9 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE_USE_DEVICE_PTR_IF_PRESENT(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_USE_DEVICE_PTR)->base.public_flag)
+#define OMP_CLAUSE_UNROLL_PARTIAL_EXPR(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_UNROLL_PARTIAL), 0)
+
#define OMP_CLAUSE_PROC_BIND_KIND(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_PROC_BIND)->omp_clause.subcode.proc_bind_kind)
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-1.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-1.f90
new file mode 100644
index 00000000000..f07aab898fa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-1.f90
@@ -0,0 +1,52 @@
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-do run }
+
+module test_functions
+ contains
+ integer function compute_sum() result(sum)
+ implicit none
+
+ integer :: i,j
+
+ !$omp do
+ do i = 1,10,3
+ !$omp unroll full
+ do j = 1,10,3
+ sum = sum + 1
+ end do
+ end do
+ end function
+
+ integer function compute_sum2() result(sum)
+ implicit none
+
+ integer :: i,j
+
+ !$omp parallel do reduction(+:sum)
+ !$omp unroll partial(2)
+ do i = 1,10,3
+ do j = 1,10,3
+ sum = sum + 1
+ end do
+ end do
+ end function
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum ()
+ write (*,*) result
+ if (result .ne. 16) then
+ call abort
+ end if
+
+ result = compute_sum2 ()
+ write (*,*) result
+ if (result .ne. 16) then
+ call abort
+ end if
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-2.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-2.f90
new file mode 100644
index 00000000000..2ce44d4d044
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-2.f90
@@ -0,0 +1,88 @@
+! { dg-additional-options "-fdump-tree-original -g" }
+! { dg-do run }
+
+module test_functions
+contains
+ integer function compute_sum1 () result(sum)
+ implicit none
+
+ integer :: i
+
+ sum = 0
+ !$omp unroll full
+ do i = 1,10,3
+ sum = sum + 1
+ end do
+ end function compute_sum1
+
+ integer function compute_sum2() result(sum)
+ implicit none
+
+ integer :: i
+
+ sum = 0
+ !$omp unroll full
+ do i = -20,1,3
+ sum = sum + 1
+ end do
+ end function compute_sum2
+
+
+ integer function compute_sum3() result(sum)
+ implicit none
+
+ integer :: i
+
+ sum = 0
+ !$omp unroll full
+ do i = 30,1,-3
+ sum = sum + 1
+ end do
+ end function compute_sum3
+
+
+ integer function compute_sum4() result(sum)
+ implicit none
+
+ integer :: i
+
+ sum = 0
+ !$omp unroll full
+ do i = 50,-60,-10
+ sum = sum + 1
+ end do
+ end function compute_sum4
+
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum1 ()
+ write (*,*) result
+ if (result .ne. 4) then
+ call abort
+ end if
+
+ result = compute_sum2 ()
+ write (*,*) result
+ if (result .ne. 8) then
+ call abort
+ end if
+
+ result = compute_sum3 ()
+ write (*,*) result
+ if (result .ne. 10) then
+ call abort
+ end if
+
+ result = compute_sum4 ()
+ write (*,*) result
+ if (result .ne. 12) then
+ call abort
+ end if
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-3.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-3.f90
new file mode 100644
index 00000000000..55e5cc568a5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-3.f90
@@ -0,0 +1,59 @@
+! Test lowering of the internal representation of "omp unroll" loops
+! which are not unrolled.
+
+! { dg-additional-options "-O0" }
+! { dg-additional-options "--param=omp-unroll-full-max-iterations=0" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops-details -fopt-info-optimized" }
+! { dg-do run }
+
+module test_functions
+contains
+ integer function compute_sum1 () result(sum)
+ implicit none
+
+ integer :: i
+
+ sum = 0
+ !$omp unroll
+ do i = 0,50
+ sum = sum + 1
+ end do
+ end function compute_sum1
+
+ integer function compute_sum3 (step,n) result(sum)
+ implicit none
+ integer :: i, step, n
+
+ sum = 0
+ do i = 0,n,step
+ sum = sum + 1
+ end do
+ end function compute_sum3
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum1 ()
+ if (result .ne. 51) then
+ call abort
+ end if
+
+ result = compute_sum3 (1, 100)
+ if (result .ne. 101) then
+ call abort
+ end if
+
+ result = compute_sum3 (2, 100)
+ if (result .ne. 51) then
+ call abort
+ end if
+
+ result = compute_sum3 (-2, -100)
+ if (result .ne. 51) then
+ call abort
+ end if
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-4.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-4.f90
new file mode 100644
index 00000000000..52a214f1049
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-4.f90
@@ -0,0 +1,72 @@
+! { dg-additional-options "-O0 -g" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops-details -fopt-info-optimized" }
+! { dg-do run }
+
+module test_functions
+contains
+ integer function compute_sum1 () result(sum)
+ implicit none
+
+ integer :: i
+
+ sum = 0
+ !$omp unroll partial(2)
+ do i = 1,50
+ sum = sum + 1
+ end do
+ end function compute_sum1
+
+ integer function compute_sum3 (step,n) result(sum)
+ implicit none
+ integer :: i, step, n
+
+ sum = 0
+ !$omp unroll partial(5)
+ do i = 1,n,step
+ sum = sum + 1
+ end do
+ end function compute_sum3
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum1 ()
+ write (*,*) result
+ if (result .ne. 50) then
+ call abort
+ end if
+
+ result = compute_sum3 (1, 100)
+ write (*,*) result
+ if (result .ne. 100) then
+ call abort
+ end if
+
+ result = compute_sum3 (1, 9)
+ write (*,*) result
+ if (result .ne. 9) then
+ call abort
+ end if
+
+ result = compute_sum3 (2, 96)
+ write (*,*) result
+ if (result .ne. 48) then
+ call abort
+ end if
+
+ result = compute_sum3 (-2, -98)
+ write (*,*) result
+ if (result .ne. 50) then
+ call abort
+ end if
+
+ result = compute_sum3 (-2, -100)
+ write (*,*) result
+ if (result .ne. 51) then
+ call abort
+ end if
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-5.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-5.f90
new file mode 100644
index 00000000000..d6a4e739675
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-5.f90
@@ -0,0 +1,55 @@
+! { dg-additional-options "-O0 -g" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops-details -fopt-info-optimized" }
+! { dg-do run }
+
+module test_functions
+contains
+ integer function compute_sum4 (step,n) result(sum)
+ implicit none
+ integer :: i, step, n
+
+ sum = 0
+ !$omp do
+ !$omp unroll partial(5)
+ do i = 1,n,step
+ sum = sum + 1
+ end do
+ end function compute_sum4
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum4 (1, 100)
+ write (*,*) result
+ if (result .ne. 100) then
+ call abort
+ end if
+
+ result = compute_sum4 (1, 9)
+ write (*,*) result
+ if (result .ne. 9) then
+ call abort
+ end if
+
+ result = compute_sum4 (2, 96)
+ write (*,*) result
+ if (result .ne. 48) then
+ call abort
+ end if
+
+ result = compute_sum4 (-2, -98)
+ write (*,*) result
+ if (result .ne. 50) then
+ call abort
+ end if
+
+ result = compute_sum4 (-2, -100)
+ write (*,*) result
+ if (result .ne. 51) then
+ call abort
+ end if
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-6.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-6.f90
new file mode 100644
index 00000000000..1df8ce8d5bb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-6.f90
@@ -0,0 +1,105 @@
+! { dg-additional-options "-O0 -g" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops-details -fopt-info-optimized" }
+! { dg-do run }
+
+module test_functions
+contains
+ integer function compute_sum4 (step,n) result(sum)
+ implicit none
+ integer :: i, step, n
+
+ sum = 0
+ !$omp parallel do reduction(+:sum) lastprivate(i)
+ !$omp unroll partial(5)
+ do i = 1,n,step
+ sum = sum + 1
+ end do
+ end function compute_sum4
+
+ integer function compute_sum5 (step,n) result(sum)
+ implicit none
+ integer :: i, step, n
+
+ sum = 0
+ !$omp parallel do reduction(+:sum) lastprivate(i)
+ !$omp unroll partial(5) ! { dg-optimized {replaced consecutive 'omp unroll' directives by 'omp unroll auto\(50\)'} }
+ !$omp unroll partial(10)
+ do i = 1,n,step
+ sum = sum + 1
+ end do
+ end function compute_sum5
+
+ integer function compute_sum6 (step,n) result(sum)
+ implicit none
+ integer :: i, j, step, n
+
+ sum = 0
+ !$omp parallel do reduction(+:sum) lastprivate(i)
+ do i = 1,n,step
+ !$omp unroll full ! { dg-optimized {removed useless 'omp unroll auto' directives preceding 'omp unroll full'} }
+ !$omp unroll partial(10)
+ do j = 1, 1000
+ sum = sum + 1
+ end do
+ end do
+ end function compute_sum6
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum4 (1, 100)
+ if (result .ne. 100) then
+ call abort
+ end if
+
+ result = compute_sum4 (1, 9)
+ if (result .ne. 9) then
+ call abort
+ end if
+
+ result = compute_sum4 (2, 96)
+ if (result .ne. 48) then
+ call abort
+ end if
+
+ result = compute_sum4 (-2, -98)
+ if (result .ne. 50) then
+ call abort
+ end if
+
+ result = compute_sum4 (-2, -100)
+ if (result .ne. 51) then
+ call abort
+ end if
+
+ result = compute_sum5 (1, 100)
+ if (result .ne. 100) then
+ call abort
+ end if
+
+ result = compute_sum5 (1, 9)
+ if (result .ne. 9) then
+ call abort
+ end if
+
+ result = compute_sum5 (2, 96)
+ if (result .ne. 48) then
+ call abort
+ end if
+
+ result = compute_sum5 (-2, -98)
+ if (result .ne. 50) then
+ call abort
+ end if
+
+ result = compute_sum5 (-2, -100)
+ if (result .ne. 51) then
+ call abort
+ end if
+
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7.f90
new file mode 100644
index 00000000000..d25f18002ae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7.f90
@@ -0,0 +1,198 @@
+! { dg-additional-options "-O0 -cpp" }
+! { dg-do run }
+
+#ifndef UNROLL_FACTOR
+#define UNROLL_FACTOR 1
+#endif
+module test_functions
+contains
+ subroutine copy (array1, array2)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: i
+
+ !$omp parallel do
+ !$omp unroll partial(UNROLL_FACTOR)
+ do i = 1, 100
+ array1(i) = array2(i)
+ end do
+ end subroutine
+
+ subroutine copy2 (array1, array2)
+ implicit none
+
+ integer :: array1(100)
+ integer :: array2(100)
+ integer :: i
+
+ !$omp parallel do
+ !$omp unroll partial(UNROLL_FACTOR)
+ do i = 0,99
+ array1(i+1) = array2(i+1)
+ end do
+ end subroutine copy2
+
+ subroutine copy3 (array1, array2)
+ implicit none
+
+ integer :: array1(100)
+ integer :: array2(100)
+ integer :: i
+
+ !$omp parallel do lastprivate(i)
+ !$omp unroll partial(UNROLL_FACTOR)
+ do i = -49,50
+ if (i < 0) then
+ array1((-1)*i) = array2((-1)*i)
+ else
+ array1(50+i) = array2(50+i)
+ endif
+ end do
+ end subroutine copy3
+
+ subroutine copy4 (array1, array2)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(UNROLL_FACTOR)
+ do i = 2, 200, 2
+ array1(i/2) = array2(i/2)
+ end do
+ end subroutine copy4
+
+ subroutine copy5 (array1, array2)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(UNROLL_FACTOR)
+ do i = 200, 2, -2
+ array1(i/2) = array2(i/2)
+ end do
+ end subroutine
+
+ subroutine copy6 (array1, array2, lower, upper, step)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: lower, upper, step
+ integer :: i
+
+ !$omp do
+ !$omp unroll partial(UNROLL_FACTOR)
+ do i = lower, upper, step
+ array1 (i) = array2(i)
+ end do
+ end subroutine
+
+ subroutine prepare (array1, array2)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+
+ array1 = 2
+ array2 = 0
+ end subroutine
+
+ subroutine check_equal (array1, array2)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: i
+
+ do i=1,100
+ if (array1(i) /= array2(i)) then
+ write (*,*) i
+ call abort
+ end if
+ end do
+ end subroutine
+
+ subroutine check_equal_at_steps (array1, array2, lower, upper, step)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: lower, upper, step
+ integer :: i
+
+ do i=lower, upper, step
+ if (array1(i) /= array2(i)) then
+ write (*,*) i
+ call abort
+ end if
+ end do
+ end subroutine
+
+ subroutine check_unchanged_at_non_steps (array1, array2, lower, upper, step)
+ implicit none
+
+ integer :: array1(:)
+ integer :: array2(:)
+ integer :: lower, upper, step
+ integer :: i, j
+
+ do i=lower, upper,step
+ do j=i,i+step-1
+ if (array2(j) /= 0) then
+ write (*,*) i
+ call abort
+ end if
+ end do
+ end do
+ end subroutine
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: array1(100), array2(100)
+
+ call prepare (array1, array2)
+ call copy (array1, array2)
+ call check_equal (array1, array2)
+
+ call prepare (array1, array2)
+ call copy2 (array1, array2)
+ call check_equal (array1, array2)
+
+ call prepare (array1, array2)
+ call copy3 (array1, array2)
+ call check_equal (array1, array2)
+
+ call prepare (array1, array2)
+ call copy4 (array1, array2)
+ call check_equal (array1, array2)
+
+ call prepare (array1, array2)
+ call copy5 (array1, array2)
+ call check_equal (array1, array2)
+
+ call prepare (array1, array2)
+ call copy6 (array1, array2, 1, 100, 5)
+ call check_equal_at_steps (array1, array2, 1, 100, 5)
+ call check_unchanged_at_non_steps (array1, array2, 1, 100, 5)
+
+ call prepare (array1, array2)
+ call copy6 (array1, array2, 1, 50, 5)
+ call check_equal_at_steps (array1, array2, 1, 50, 5)
+ call check_unchanged_at_non_steps (array1, array2, 1, 50, 5)
+
+ call prepare (array1, array2)
+ call copy6 (array1, array2, 3, 18, 7)
+ call check_equal_at_steps (array1, array2, 3 , 18, 7)
+ call check_unchanged_at_non_steps (array1, array2, 3, 18, 7)
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7a.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7a.f90
new file mode 100644
index 00000000000..02328464c0d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7a.f90
@@ -0,0 +1,7 @@
+! { dg-additional-options "-O0 -g -cpp" }
+! { dg-do run }
+
+! Check an unroll factor that divides the number of iterations
+! of the loops in the test implementation.
+#define UNROLL_FACTOR 5
+#include "unroll-7.f90"
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7b.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7b.f90
new file mode 100644
index 00000000000..60866ef33fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7b.f90
@@ -0,0 +1,7 @@
+! { dg-additional-options "-O0 -g -cpp" }
+! { dg-do run }
+
+! Check an unroll factor that does not divide the number of iterations
+! of the loops in the test implementation.
+#define UNROLL_FACTOR 3
+#include "unroll-7.f90"
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7c.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7c.f90
new file mode 100644
index 00000000000..6d8a2ef7bc0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-7c.f90
@@ -0,0 +1,7 @@
+! { dg-additional-options "-O0 -g -cpp" }
+! { dg-do run }
+
+! Check an unroll factor that is larger than the number of iterations
+! of the loops in the test implementation.
+#define UNROLL_FACTOR 113
+#include "unroll-7.f90"
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-8.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-8.f90
new file mode 100644
index 00000000000..40506025aa3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-8.f90
@@ -0,0 +1,38 @@
+! { dg-additional-options "-O0 -g" }
+! { dg-additional-options "-fdump-tree-omp_transform_loops-details -fopt-info-optimized" }
+! { dg-do run }
+
+module test_functions
+contains
+ subroutine copy (array1, array2, step, n)
+ implicit none
+
+ integer :: array1(n)
+ integer :: array2(n)
+ integer :: i, step, n
+
+ call omp_set_num_threads (4)
+ !$omp parallel do shared(array1) shared(array2) schedule(static, 4)
+ !$omp unroll partial(2)
+ do i = 1,n
+ array1(i) = array2(i)
+ end do
+ end subroutine
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: array1(100), array2(100)
+ integer :: i
+
+ array1 = 2
+ call copy(array1, array2, 1, 100)
+ do i=1,100
+ if (array1(i) /= array2(i)) then
+ write (*,*) i
+ call abort
+ end if
+ end do
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-simd-1.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-simd-1.f90
new file mode 100644
index 00000000000..5fb64ddd6fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/unroll-simd-1.f90
@@ -0,0 +1,33 @@
+! { dg-options "-fno-openmp -fopenmp-simd" }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-do run }
+
+module test_functions
+ contains
+ integer function compute_sum() result(sum)
+ implicit none
+
+ integer :: i,j
+
+ !$omp simd
+ do i = 1,10,3
+ !$omp unroll full
+ do j = 1,10,3
+ sum = sum + 1
+ end do
+ end do
+ end function compute_sum
+end module test_functions
+
+program test
+ use test_functions
+ implicit none
+
+ integer :: result
+
+ result = compute_sum ()
+ write (*,*) result
+ if (result .ne. 16) then
+ call abort
+ end if
+end program