diff mbox

[v0] fortran: !GCC$ unroll for DO

Message ID 1422919324-29964-2-git-send-email-rep.dot.nop@gmail.com
State New
Headers show

Commit Message

Bernhard Reutner-Fischer Feb. 2, 2015, 11:22 p.m. UTC 
fortran/ChangeLog:

2015-02-02  Bernhard Reutner-Fischer  <aldot@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  <aldot@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.nop@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

Comments

Tobias Burnus Feb. 3, 2015, 8:42 a.m. UTC | #1 
Bernhard Reutner-Fischer wrote:
> Some compilers IIRC use !DIR$ unroll, if memory serves me right then
> the DEC compiler had !DEC$ unroll.
> We could support one or the other three-letter keyword or maybe not.

Intel's compiler supports quite a lot of loop directives. (Its Fortran
front end is based on DEC's and part of the developer team also moved
from Compaq to Intel. Not that Intel didn't add a bunch of additional
directives later on.)


Supported are: simd, ivdep, loop count, (no)vector, inline, force, (no)inline,
(no)unroll, unroll_and_jam, nofusion and distribution point.

GCC support "ivdep" (C/C++), simd (I think only via -fcilkplus; but
OpenMP's 'omp simd' is a replacement [-fopenmp/-fopenmp-simd] in C/C++ and
Fortran) - and "unroll" as proposed for C/C++ and with this patch for
Fortran.

By the way: gfortran automatically annotates 'do concurrent' with 'ivdep'.

For Intel's loop directives, see:
https://software.intel.com/en-us/articles/getting-started-with-intel-composer-xe-2013-compiler-pragmas-and-directives
C++: https://software.intel.com/en-us/node/524494
Fortran: https://software.intel.com/en-us/node/525781


 * * *

Regarding the patch: In general, I prefer to stick to standard methods
(which are portable) and think that those user knobs often make things
slower than faster (as they tend to stay for years, even after the hard-
ware as moved on - or they are even inserted blindly).
till, I think it would be fine to add it.

Tobias

PS: For a non-RFC patch, you also need to update gfortran.texi.
diff mbox

Patch

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
+