fortran/ChangeLog:
2015-02-02 Bernhard Reutner-Fischer <al...@gcc.gnu.org>
* match.h (gfc_match_gcc_unroll): New prototype.
* decl.c (directive_unroll): New global variable.
(gfc_match_gcc_unroll): New function.
* gfortran.h (directive_unroll): New extern declaration.
[gfc_iterator]: New member unroll.
* parse.c (decode_gcc_attribute): Match "unroll".
(parse_do_block): Set iterator's unroll.
(parse_executable): Diagnose misplaced unroll directive.
* trans.h (gfc_cfun_has_unroll): New prototype.
* trans-decl.c (gfc_cfun_has_unroll): New function.
* trans-stmt.c (gfc_trans_simple_do, gfc_trans_do): Annotate
loop condition with annot_expr_unroll_kind.
testsuite/ChangeLog:
2015-02-02 Bernhard Reutner-Fischer <al...@gcc.gnu.org>
* gfortran.dg/directive_unroll_1.f90: New testcase.
* gfortran.dg/directive_unroll_2.f90: Likewise.
Signed-off-by: Bernhard Reutner-Fischer <rep.dot....@gmail.com>
---
gcc/fortran/decl.c | 38 ++++++++++++++++++++
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/match.h | 1 +
gcc/fortran/parse.c | 13 ++++++-
gcc/fortran/trans-decl.c | 7 ++++
gcc/fortran/trans-stmt.c | 14 ++++++++
gcc/fortran/trans.h | 3 ++
gcc/testsuite/gfortran.dg/directive_unroll_1.f90 | 46 ++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/directive_unroll_2.f90 | 39 ++++++++++++++++++++
9 files changed, 162 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/directive_unroll_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/directive_unroll_2.f90
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 40d851c..713e6ee 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -103,6 +103,8 @@ gfc_symbol *gfc_new_block;
bool gfc_matching_function;
+/* Set upon parsing a !GCC$ unroll n directive for use in the next loop. */
+int directive_unroll = -1;
/********************* DATA statement subroutines *********************/
@@ -8866,3 +8868,39 @@ syntax:
gfc_error ("Syntax error in !GCC$ ATTRIBUTES statement at %C");
return MATCH_ERROR;
}
+
+
+/* Match a !GCC$ UNROLL statement of the form:
+ !GCC$ UNROLL n
+
+ The parameter n is the number of times we are supposed to unroll;
+ Refer to the C frontend and loop-unroll.c decide_unrolling() for details.
+
+ When we come here, we have already matched the !GCC$ UNROLL string.
+ */
+match
+gfc_match_gcc_unroll (void)
+{
+ signed int value;
+
+ if (gfc_match_small_int (&value) == MATCH_YES)
+ {
+ if (value < 0 || value > USHRT_MAX)
+ {
+ gfc_error ("%<GCC unroll%> directive requires a"
+ " non-negative integral constant"
+ " less than or equal to %u at %C",
+ USHRT_MAX
+ );
+ return MATCH_ERROR;
+ }
+ if (gfc_match_eos () == MATCH_YES)
+ {
+ directive_unroll = value;
+ return MATCH_YES;
+ }
+ }
+
+ gfc_error ("Syntax error in !GCC$ UNROLL directive at %C");
+ return MATCH_ERROR;
+}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6b9f7dd..7bd2432 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2185,6 +2185,7 @@ gfc_case;
typedef struct
{
gfc_expr *var, *start, *end, *step;
+ unsigned short unroll;
}
gfc_iterator;
@@ -2546,6 +2547,7 @@ gfc_finalizer;
/* decl.c */
bool gfc_in_match_data (void);
match gfc_match_char_spec (gfc_typespec *);
+extern int directive_unroll;
/* scanner.c */
void gfc_scanner_done_1 (void);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 96d3ec1..30c0aa3 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -219,6 +219,7 @@ match gfc_match_contiguous (void);
match gfc_match_dimension (void);
match gfc_match_external (void);
match gfc_match_gcc_attributes (void);
+match gfc_match_gcc_unroll (void);
match gfc_match_import (void);
match gfc_match_intent (void);
match gfc_match_intrinsic (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 2c7c554..95c35b9 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -882,6 +882,7 @@ decode_gcc_attribute (void)
old_locus = gfc_current_locus;
match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
+ match ("unroll", gfc_match_gcc_unroll, ST_NONE);
/* All else has failed, so give up. See if any of the matchers has
stored an error message of some sort. */
@@ -4020,7 +4021,14 @@ parse_do_block (void)
s.ext.end_do_label = new_st.label1;
if (new_st.ext.iterator != NULL)
- stree = new_st.ext.iterator->var->symtree;
+ {
+ stree = new_st.ext.iterator->var->symtree;
+ if (directive_unroll != -1)
+ {
+ new_st.ext.iterator->unroll = directive_unroll;
+ directive_unroll = -1;
+ }
+ }
else
stree = NULL;
@@ -4745,6 +4753,9 @@ parse_executable (gfc_statement st)
return st;
}
+ if (directive_unroll != -1)
+ gfc_error ("%<GCC unroll%> directive does not commence a loop at %C");
+
st = next_statement ();
}
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 8a65d2b..3965541 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -6117,5 +6117,12 @@ gfc_process_block_locals (gfc_namespace* ns)
saved_local_decls = NULL_TREE;
}
+/* Hint to the ME that the current function has an unroll directive. */
+
+void
+gfc_cfun_has_unroll (void)
+{
+ cfun->has_unroll = true;
+}
#include "gt-fortran-trans-decl.h"
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 01bfd97..5379c7b 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1570,6 +1570,13 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t
*pblock, tree dovar,
cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, dovar,
to);
cond = gfc_evaluate_now_loc (loc, cond, &body);
+ if (code->ext.iterator->unroll && cond != error_mark_node)
+ {
+ cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+ build_int_cst (integer_type_node, annot_expr_unroll_kind),
+ build_int_cst (integer_type_node, code->ext.iterator->unroll));
+ gfc_cfun_has_unroll ();
+ }
/* Increment the loop variable. */
tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
@@ -1870,6 +1877,13 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
/* End with the loop condition. Loop until countm1t == 0. */
cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, countm1t,
build_int_cst (utype, 0));
+ if (code->ext.iterator->unroll && cond != error_mark_node)
+ {
+ cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+ build_int_cst (integer_type_node, annot_expr_unroll_kind),
+ build_int_cst (integer_type_node, code->ext.iterator->unroll));
+ gfc_cfun_has_unroll ();
+ }
tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
cond, tmp, build_empty_stmt (loc));
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index bd1520a..fbd392b 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -665,6 +665,9 @@ tree gfc_build_library_function_decl_with_spec (tree name,
const char *spec,
/* Process the local variable decls of a block construct. */
void gfc_process_block_locals (gfc_namespace*);
+/* Hint to the ME that the current function has an unroll directive. */
+void gfc_cfun_has_unroll (void);
+
/* Output initialization/clean-up code that was deferred. */
void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *);
diff --git a/gcc/testsuite/gfortran.dg/directive_unroll_1.f90
b/gcc/testsuite/gfortran.dg/directive_unroll_1.f90
new file mode 100644
index 0000000..ebaa2f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/directive_unroll_1.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-rtl-loop2_unroll -fdump-tree-cunrolli-details" }
+! Test that
+! #pragma GCC unroll n
+! works
+
+! { dg-final { scan-tree-dump-not "note: loop turned into non-loop; it never
loops" "cunrolli" } }
+
+subroutine simple1(n)
+ implicit NONE
+ integer (kind=1), intent(in) :: n
+ integer (kind=4) :: i
+!GCC$ unroll 8
+ DO i=0, n, 1
+ call dummy1(i)
+ ENDDO
+! { dg-final { scan-tree-dump "15:0: note: loop unrolled 7 times"
"loop2_unroll" } }
+end subroutine simple1
+
+subroutine simple2(a, b, n)
+ implicit NONE
+ integer (kind=1), intent(in) :: n
+ integer :: a(n), b(n)
+ integer (kind=4) :: i
+!GCC$ unroll 8
+ DO i=n, 0, -1
+ call dummy2(a(i), b(i), i)
+ ENDDO
+! { dg-final { scan-tree-dump "27:0: note: loop unrolled 7 times"
"loop2_unroll" } }
+end subroutine simple2
+
+subroutine not_simple1(a, b, n)
+ implicit NONE
+ integer (kind=1), intent(in) :: n
+ integer :: a(n), b(n)
+ integer (kind=4) :: i
+!GCC$ unroll 8
+ DO i=0, n, 2
+ call dummy2(a(i), b(i), i)
+ ENDDO
+! { dg-final { scan-tree-dump "38:0: note: loop unrolled 7 times"
"loop2_unroll" } }
+! { dg-final { scan-tree-dump "38:0: note: not unrolling loop, user didn't
want it unrolled completely" "cunrolli" } }
+end subroutine not_simple1
+
+! { dg-final { cleanup-tree-dump "cunrolli" } }
+! { dg-final { cleanup-rtl-dump "loop2_unroll" } }
diff --git a/gcc/testsuite/gfortran.dg/directive_unroll_2.f90
b/gcc/testsuite/gfortran.dg/directive_unroll_2.f90
new file mode 100644
index 0000000..59804a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/directive_unroll_2.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+
+! Test that
+! #pragma GCC unroll n
+! rejects invalid n and improper use
+
+subroutine wrong1(n)
+ implicit NONE
+ integer (kind=1), intent(in) :: n
+ integer (kind=4) :: i
+!GCC$ unroll 999999999 ! { dg-error "non-negative integral constant less than"
}
+ DO i=0, n, 1
+ call dummy1(i)
+ ENDDO
+end subroutine wrong1
+
+subroutine wrong2(a, b, n)
+ implicit NONE
+ integer (kind=1), intent(in) :: n
+ integer :: a(n), b(n)
+ integer (kind=4) :: i
+!GCC$ unroll -1 ! { dg-error "non-negative integral constant less than" }
+ DO i=0, n, 2
+ call dummy2(a(i), b(i), i)
+ ENDDO
+end subroutine wrong2
+
+subroutine wrong3(a, b, n)
+ implicit NONE
+ integer (kind=1), intent(in) :: n
+ integer :: a(n), b(n)
+ integer (kind=4) :: i
+!GCC$ unroll 8
+ write (*,*) "wrong"! { dg-error "directive does not commence a loop" }
+ DO i=n, 0, -1
+ call dummy2(a(i), b(i), i)
+ ENDDO
+end subroutine wrong3
+
--
2.1.4
