[PATCH, RFC] fortran [was Re: #pragma GCC unroll support]

[PATCH, RFC] fortran [was Re: #pragma GCC unroll support]

[Bernhard Reutner-Fischer]

Hi,

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.

I think a combination of unroll and ivdep directives is allowed (at
least in some compilers); TODO.

Not sure what other statements should be annotated with that directive?

I do not like the global variable directive_unroll but is was the easy
way out for cheap warnings.

Untested draft patch, regstrap running over night, depends on Mike's
unroll-5.diffs.txt patch in this thread (
https://gcc.gnu.org/ml/gcc-patches/2015-01/msg02733.html ).

Just stage-1 tinkering here.

Cheers,

Bernhard Reutner-Fischer (1):
  fortran: !GCC$ unroll for DO

 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

-- 
2.1.4

[PATCH, v0] fortran: !GCC$ unroll for DO

[Bernhard Reutner-Fischer]

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

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

Re: [PATCH, RFC] fortran [was Re: #pragma GCC unroll support]

[Mike Stump]

On Feb 2, 2015, at 3:22 PM, Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> wrote:
> Untested draft patch

I looked it over, seems to slot in nicely.


+	gfc_error ("%<GCC unroll%> directive does not commence a loop at %C”);

So, don’t like commence here.

Re: [PATCH, v0] fortran: !GCC$ unroll for DO

[Tobias Burnus]

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.

Re: [PATCH, RFC] fortran [was Re: #pragma GCC unroll support]

[Bernhard Reutner-Fischer]

On 3 February 2015 at 01:07, Mike Stump <mikestump@comcast.net> wrote:
> On Feb 2, 2015, at 3:22 PM, Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> wrote:
>> Untested draft patch
>
> I looked it over, seems to slot in nicely.
>
>
> +       gfc_error ("%<GCC unroll%> directive does not commence a loop at %C”);
>
> So, don’t like commence here.

Does anybody have a better suggestion?

directive not at the start of a loop at %C
directive not followed by a loop at %C

dunno..

Mike, did you tweak the one or two things you got from the reviews
yet? ISTM your
main patch was not OKed yet nor installed.

thanks,

Re: [PATCH, RFC] fortran [was Re: #pragma GCC unroll support]

[Mike Stump]

On May 28, 2015, at 2:02 AM, Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> wrote:
> 
> Does anybody have a better suggestion?
> 
> directive not at the start of a loop at %C
> directive not followed by a loop at %C

I prefer either of these.  I have a slight preference for the first.

> Mike, did you tweak the one or two things you got from the reviews
> yet?

Nope.

> ISTM your main patch was not OKed yet nor installed.

Been busy with work.  I’ll come back and address the nits that people pointed out and see if I can ping it some more and try and get the C++ bits reviewed.

Re: [PATCH, RFC] fortran [was Re: #pragma GCC unroll support]

[Bernhard Reutner-Fischer]

On May 28, 2015 2:03:08 PM GMT+02:00, Mike Stump <mikestump@comcast.net> wrote:
>On May 28, 2015, at 2:02 AM, Bernhard Reutner-Fischer
><rep.dot.nop@gmail.com> wrote:
>> 
>> Does anybody have a better suggestion?
>> 
>> directive not at the start of a loop at %C
>> directive not followed by a loop at %C
>
>I prefer either of these.  I have a slight preference for the first.

I've changed the Fortran error to the first locally.

>
>> Mike, did you tweak the one or two things you got from the reviews
>> yet?
>
>Nope.
>
>> ISTM your main patch was not OKed yet nor installed.
>
>Been busy with work.  I’ll come back and address the nits that people
>pointed out and see if I can ping it some more and try and get the C++
>bits reviewed.

I take it you're well aware that stage 1 will end in a couple of weeks, and maybe you want to have this in GCC-6, so now would be the perfect time.. :)

Cheers,