[fortran] Add support for #pragma GCC unroll v3

[fortran] Add support for #pragma GCC unroll v3

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 1426 bytes --]

Hi,

this is the (hopefully) final implementation of the support for the unrolling 
pragma in the Fortran front-end.  However the documentation is still missing 
because I don't really know where and under which form to put it.

Tested on x86_64-suse-linux, OK for the mainline?


2017-11-25  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>
            Eric Botcazou  <ebotcazou@adacore.com>

fortran/ChangeLog:
        * array.c (gfc_copy_iterator): Copy unroll field.
        * decl.c (directive_unroll): New global variable.
        (gfc_match_gcc_unroll): New function.
        * gfortran.h (gfc_iterator]): Add unroll field.
        (directive_unroll): Declare:
        * match.c (gfc_match_do): Use memset to initialize the iterator.
        * match.h (gfc_match_gcc_unroll): New prototype.
        * parse.c (decode_gcc_attribute): Match "unroll".
        (parse_do_block): Set iterator's unroll.
        (parse_executable): Diagnose misplaced unroll directive.
        * trans-stmt.c (gfc_trans_simple_do) Annotate loop condition with
        annot_expr_unroll_kind.
        (gfc_trans_do): Likewise.

testsuite/ChangeLog:
        * gfortran.dg/directive_unroll_1.f90: New test.
        * gfortran.dg/directive_unroll_2.f90: Likewise.
        * gfortran.dg/directive_unroll_3.f90: Lkewise.
        * gfortran.dg/directive_unroll_4.f90: Likewise.
        * gfortran.dg/directive_unroll_5.f90: Likewise.

-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 12951 bytes --]

Index: fortran/array.c
===================================================================
--- fortran/array.c	(revision 255147)
+++ fortran/array.c	(working copy)
@@ -2123,6 +2123,7 @@ gfc_copy_iterator (gfc_iterator *src)
   dest->start = gfc_copy_expr (src->start);
   dest->end = gfc_copy_expr (src->end);
   dest->step = gfc_copy_expr (src->step);
+  dest->unroll = src->unroll;
 
   return dest;
 }
Index: fortran/decl.c
===================================================================
--- fortran/decl.c	(revision 255147)
+++ fortran/decl.c	(working copy)
@@ -95,6 +95,9 @@ 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;
+
 /* If a kind expression of a component of a parameterized derived type is
    parameterized, temporarily store the expression here.  */
 static gfc_expr *saved_kind_expr = NULL;
@@ -104,7 +107,6 @@ static gfc_expr *saved_kind_expr = NULL;
 static gfc_actual_arglist *decl_type_param_list;
 static gfc_actual_arglist *type_param_spec_list;
 
-
 /********************* DATA statement subroutines *********************/
 
 static bool in_match_data = false;
@@ -10943,3 +10945,37 @@ 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.
+
+   When we come here, we have already matched the !GCC$ UNROLL string.  */
+match
+gfc_match_gcc_unroll (void)
+{
+  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 == 0 ? 1 : value;
+	  return MATCH_YES;
+	}
+    }
+
+  gfc_error ("Syntax error in !GCC$ UNROLL directive at %C");
+  return MATCH_ERROR;
+}
Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h	(revision 255147)
+++ fortran/gfortran.h	(working copy)
@@ -2350,6 +2350,7 @@ gfc_case;
 typedef struct
 {
   gfc_expr *var, *start, *end, *step;
+  unsigned short unroll;
 }
 gfc_iterator;
 
@@ -2724,6 +2725,7 @@ gfc_finalizer;
 /* decl.c */
 bool gfc_in_match_data (void);
 match gfc_match_char_spec (gfc_typespec *);
+extern int directive_unroll;
 
 /* Handling Parameterized Derived Types  */
 bool gfc_insert_kind_parameter_exprs (gfc_expr *);
Index: fortran/match.c
===================================================================
--- fortran/match.c	(revision 255147)
+++ fortran/match.c	(working copy)
@@ -2539,8 +2539,8 @@ gfc_match_do (void)
 
   old_loc = gfc_current_locus;
 
+  memset (&iter, '\0', sizeof (gfc_iterator));
   label = NULL;
-  iter.var = iter.start = iter.end = iter.step = NULL;
 
   m = gfc_match_label ();
   if (m == MATCH_ERROR)
Index: fortran/match.h
===================================================================
--- fortran/match.h	(revision 255147)
+++ fortran/match.h	(working copy)
@@ -241,6 +241,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);
Index: fortran/parse.c
===================================================================
--- fortran/parse.c	(revision 255147)
+++ fortran/parse.c	(working copy)
@@ -1063,6 +1063,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.  */
@@ -4635,7 +4636,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;
 
@@ -5393,6 +5401,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 ();
     }
 }
Index: fortran/trans-stmt.c
===================================================================
--- fortran/trans-stmt.c	(revision 255147)
+++ fortran/trans-stmt.c	(working copy)
@@ -1979,6 +1979,11 @@ gfc_trans_simple_do (gfc_code * code, st
 			    fold_convert (type, 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));
 
   /* The loop exit.  */
   tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
@@ -2305,6 +2310,11 @@ gfc_trans_do (gfc_code * code, tree exit
   /* End with the loop condition.  Loop until countm1t == 0.  */
   cond = fold_build2_loc (loc, EQ_EXPR, logical_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));
   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));
Index: testsuite/gfortran.dg/directive_unroll_1.f90
===================================================================
--- testsuite/gfortran.dg/directive_unroll_1.f90	(revision 0)
+++ testsuite/gfortran.dg/directive_unroll_1.f90	(working copy)
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-cunrolli-details -fdump-rtl-loop2_unroll-details" }
+! Test that
+! #pragma GCC unroll n
+! works
+
+subroutine test1(a)
+  implicit NONE
+  integer :: a(8)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, 8, 1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-tree-dump "12:.*: note: loop with 8 iterations completely unrolled" "cunrolli" } } */
+end subroutine test1
+
+subroutine test2(a, n)
+  implicit NONE
+  integer :: a(n)
+  integer (kind=1), intent(in) :: n
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, n, 1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "24:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test2
+
+subroutine test3(a, n)
+  implicit NONE
+  integer (kind=1), intent(in) :: n
+  integer :: a(n)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=n, 1, -1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "36:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test3
+
+subroutine test4(a, n)
+  implicit NONE
+  integer (kind=1), intent(in) :: n
+  integer :: a(n)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, n, 2
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "48:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test4
Index: testsuite/gfortran.dg/directive_unroll_2.f90
===================================================================
--- testsuite/gfortran.dg/directive_unroll_2.f90	(revision 0)
+++ testsuite/gfortran.dg/directive_unroll_2.f90	(working copy)
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-O -fdump-tree-cunroll-details -fdump-rtl-loop2_unroll-details" }
+! Test that
+! #pragma GCC unroll n
+! works
+
+subroutine test1(a)
+  implicit NONE
+  integer :: a(8)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, 8, 1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-tree-dump "12:.*: note: loop with 7 iterations completely unrolled" "cunroll" } } */
+end subroutine test1
+
+subroutine test2(a, n)
+  implicit NONE
+  integer :: a(n)
+  integer (kind=1), intent(in) :: n
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, n, 1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "24:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test2
+
+subroutine test3(a, n)
+  implicit NONE
+  integer (kind=1), intent(in) :: n
+  integer :: a(n)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=n, 1, -1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "36:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test3
+
+subroutine test4(a, n)
+  implicit NONE
+  integer (kind=1), intent(in) :: n
+  integer :: a(n)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, n, 2
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "48:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test4
Index: testsuite/gfortran.dg/directive_unroll_3.f90
===================================================================
--- testsuite/gfortran.dg/directive_unroll_3.f90	(revision 0)
+++ testsuite/gfortran.dg/directive_unroll_3.f90	(working copy)
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-O -fdisable-tree-cunroll -fdump-rtl-loop2_unroll-details" }
+! Test that
+! #pragma GCC unroll n
+! works
+
+subroutine test1(a)
+  implicit NONE
+  integer :: a(8)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, 8, 1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump-not "12:.: note: loop unrolled" "loop2_unroll" } }
+end subroutine test1
+
+subroutine test2(a, n)
+  implicit NONE
+  integer :: a(n)
+  integer (kind=1), intent(in) :: n
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, n, 1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "24:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test2
+
+subroutine test3(a, n)
+  implicit NONE
+  integer (kind=1), intent(in) :: n
+  integer :: a(n)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=n, 1, -1
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "36:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test3
+
+subroutine test4(a, n)
+  implicit NONE
+  integer (kind=1), intent(in) :: n
+  integer :: a(n)
+  integer (kind=4) :: i
+!GCC$ unroll 8
+  DO i=1, n, 2
+    call dummy(a(i))
+  ENDDO
+! { dg-final { scan-rtl-dump "48:.: note: loop unrolled 7 times" "loop2_unroll" } }
+end subroutine test4
Index: testsuite/gfortran.dg/directive_unroll_4.f90
===================================================================
--- testsuite/gfortran.dg/directive_unroll_4.f90	(revision 0)
+++ testsuite/gfortran.dg/directive_unroll_4.f90	(working copy)
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-O2 -funroll-all-loops -fdump-rtl-loop2_unroll-details -fdump-tree-cunrolli-details" }
+! Test that
+! #pragma GCC unroll n
+! works
+
+subroutine test1(a)
+  implicit NONE
+  integer :: a(8)
+  integer (kind=4) :: i
+!GCC$ unroll 0
+  DO i=1, 8, 1
+    call dummy(a(i))
+  ENDDO
+end subroutine test1
+
+subroutine test2(a, n)
+  implicit NONE
+  integer :: a(n)
+  integer (kind=1), intent(in) :: n
+  integer (kind=4) :: i
+!GCC$ unroll 0
+  DO i=1, n, 1
+    call dummy(a(i))
+  ENDDO
+end subroutine test2
+
+! { dg-final { scan-tree-dump "Not unrolling loop .: user didn't want it unrolled completely" "cunrolli" } } */
+! { dg-final { scan-rtl-dump-times "Not unrolling loop, user didn't want it unrolled" 2 "loop2_unroll" } } */
Index: testsuite/gfortran.dg/directive_unroll_5.f90
===================================================================
--- testsuite/gfortran.dg/directive_unroll_5.f90	(revision 0)
+++ testsuite/gfortran.dg/directive_unroll_5.f90	(working copy)
@@ -0,0 +1,38 @@
+! { 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=1, 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, 1, -1
+    call dummy2(a(i), b(i), i)
+  ENDDO
+end subroutine wrong3

Re: [fortran] Add support for #pragma GCC unroll v3

[Steve Kargl]

On Sat, Nov 25, 2017 at 11:21:49AM +0100, Eric Botcazou wrote:
> 
> this is the (hopefully) final implementation of the support for the unrolling 
> pragma in the Fortran front-end.  However the documentation is still missing 
> because I don't really know where and under which form to put it.
> 
> Tested on x86_64-suse-linux, OK for the mainline?
> 

Eric, 

The patch looks ok to me.  For documentation, the gfortran
manual has 2 sections:

6.1 Extensions implemented in GNU Fortran
7.2 GNU Fortran Compiler Directives

6.1 describes extension covering legacy code and vendor extensions.
7.2 describes other !$GCC directives.  Currently, the section is
mainly calling conventions (CDECL, STDCALL, etc) and library 
macroc (DLLEXPORT).  These should probably be in 7.2.1 and the 
UNROLL directive in 7.2.2.

I can help with the documentation (although it might take a weekend
or two to get done), but need to know sematics.  Does the directive
apply to only the immediately following loop?  Does it apply to all
loops that follow the directive?  What is the interaction of the
directive with -funroll-loops and --param max-unroll-times=4?

-- 
Steve

Re: [fortran] Add support for #pragma GCC unroll v3

[Eric Botcazou]

> The patch looks ok to me.

Thanks.

> For documentation, the gfortran manual has 2 sections:
> 
> 6.1 Extensions implemented in GNU Fortran
> 7.2 GNU Fortran Compiler Directives
> 
> 6.1 describes extension covering legacy code and vendor extensions.
> 7.2 describes other !$GCC directives.  Currently, the section is
> mainly calling conventions (CDECL, STDCALL, etc) and library
> macroc (DLLEXPORT).  These should probably be in 7.2.1 and the
> UNROLL directive in 7.2.2.
> 
> I can help with the documentation (although it might take a weekend
> or two to get done), but need to know sematics.  Does the directive
> apply to only the immediately following loop?  Does it apply to all
> loops that follow the directive?

The former.  Here's the documentation for the C & C++ compilers:

`#pragma GCC unroll N'
     You can use this pragma to control how many times a loop should be
     unrolled.  It must be placed immediately before a `for', `while'
     or `do' loop or a `#pragma GCC ivdep', and applies only to the
     loop that follows.  N is an integer constant expression specifying
     the unrolling factor.  The values of 0 and 1 block any unrolling
     of the loop.

> What is the interaction of the directive with -funroll-loops and --param
> max-unroll-times=4?

It's independent and always prevails, i.e. it doesn't need -funroll-loops to 
be effective, #pragma GCC 0 will block unrolling despite -funroll-loops and 
#pragma GCC N wins over --param max-unroll-times=M.

-- 
Eric Botcazou

Re: [fortran] Add support for #pragma GCC unroll v3

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 445 bytes --]

> 6.1 Extensions implemented in GNU Fortran
> 7.2 GNU Fortran Compiler Directives
> 
> 6.1 describes extension covering legacy code and vendor extensions.
> 7.2 describes other !$GCC directives.  Currently, the section is
> mainly calling conventions (CDECL, STDCALL, etc) and library
> macroc (DLLEXPORT).  These should probably be in 7.2.1 and the
> UNROLL directive in 7.2.2.

Attached is a minimal patch along these lines.

-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 1285 bytes --]

Index: fortran/gfortran.texi
===================================================================
--- fortran/gfortran.texi	(revision 255437)
+++ fortran/gfortran.texi	(working copy)
@@ -3423,6 +3423,14 @@ as this requires the new array descripto
 @node GNU Fortran Compiler Directives
 @section GNU Fortran Compiler Directives
 
+@menu
+* ATTRIBUTES directive::
+* UNROLL directive::
+@end menu
+
+@node ATTRIBUTES directive
+@subsection ATTRIBUTES directive
+
 The Fortran standard describes how a conforming program shall
 behave; however, the exact implementation is not standardized.  In order
 to allow the user to choose specific implementation details, compiler
@@ -3496,6 +3504,19 @@ of the procedure; for variables and proc
 the same declaration part as the variable or procedure pointer.
 
 
+@node UNROLL directive
+@subsection UNROLL directive
+
+The syntax of the directive is
+
+@code{!GCC$ unroll N}
+
+You can use this directive to control how many times a loop should be unrolled.
+It must be placed immediately before a @code{DO} loop and applies only to the
+loop that follows.  N is an integer constant specifying the unrolling factor.
+The values of 0 and 1 block any unrolling of the loop.
+
+
 
 @node Non-Fortran Main Program
 @section Non-Fortran Main Program

Re: [fortran] Add support for #pragma GCC unroll v3

[Janne Blomqvist]

On Wed, Dec 6, 2017 at 11:21 AM, Eric Botcazou <ebotcazou@adacore.com> wrote:
>> 6.1 Extensions implemented in GNU Fortran
>> 7.2 GNU Fortran Compiler Directives
>>
>> 6.1 describes extension covering legacy code and vendor extensions.
>> 7.2 describes other !$GCC directives.  Currently, the section is
>> mainly calling conventions (CDECL, STDCALL, etc) and library
>> macroc (DLLEXPORT).  These should probably be in 7.2.1 and the
>> UNROLL directive in 7.2.2.
>
> Attached is a minimal patch along these lines.

Ok, thanks for the patch.


-- 
Janne Blomqvist