[Patch] openmp: Map holds clause to IFN_ASSUME for Fortran

[Patch] openmp: Map holds clause to IFN_ASSUME for Fortran

[Tobias Burnus]

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

Same as for C/C++, albeit a tiny bit longer patch.

I don't know whether it makes sense to handle – in the long run – the
case of se.pre/se.post being nonempty – and, if so, how.

OK for mainline?

Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: omp-assumes-hold.diff --]
[-- Type: text/x-patch, Size: 3389 bytes --]

openmp: Map holds clause to IFN_ASSUME for Fortran

Same as r13-3107-g847f5addc4d07a2f3b95f5daa50ab4a64dfd957d did for C/C++.
Convert '!$omp assume holds(cond)' to IFN_ASSUME (cond).
    
gcc/fortran/
	* trans-openmp.cc (gfc_trans_omp_assume): New.
	(gfc_trans_omp_directive): Call it.

gcc/teststuite/
	* gfortran.dg/gomp/assume-3.f90: New test.

 gcc/fortran/trans-openmp.cc                 | 27 ++++++++++++++++-
 gcc/testsuite/gfortran.dg/gomp/assume-3.f90 | 46 +++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 21053694f81..b82257258a7 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4570,6 +4570,31 @@ gfc_trans_oacc_wait_directive (gfc_code *code)
 static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
 static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 
+static tree
+gfc_trans_omp_assume (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_init_block (&block);
+  gfc_omp_assumptions *assume = code->ext.omp_clauses->assume;
+  if (assume)
+    for (gfc_expr_list *el = assume->holds; el; el = el->next)
+      {
+	tree t;
+	gfc_se se;
+	gfc_init_se (&se, NULL);
+	gfc_conv_expr (&se, el->expr);
+	/* Avoid side effects. */
+	if (se.pre.head || se.post.head)
+	  continue;
+	t = build_call_expr_internal_loc (gfc_get_location (&el->expr->where),
+					  IFN_ASSUME, void_type_node, 1,
+					  se.expr);
+	gfc_add_expr_to_block (&block, t);
+      }
+  gfc_add_expr_to_block (&block, gfc_trans_omp_code (code->block->next, true));
+  return gfc_finish_block (&block);
+}
+
 static tree
 gfc_trans_omp_atomic (gfc_code *code)
 {
@@ -7488,7 +7513,7 @@ gfc_trans_omp_directive (gfc_code *code)
   switch (code->op)
     {
     case EXEC_OMP_ASSUME:
-      return gfc_trans_omp_code (code->block->next, true);
+      return gfc_trans_omp_assume (code);
     case EXEC_OMP_ATOMIC:
       return gfc_trans_omp_atomic (code);
     case EXEC_OMP_BARRIER:
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-3.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-3.f90
new file mode 100644
index 00000000000..e5deace306e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-3.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -O2 -fdump-tree-optimized -fdump-tree-original" }
+
+! { dg-final { scan-tree-dump-times ".ASSUME \\(x == 42\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(x <= 41\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(y <= 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(y > 5\\);" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "return 42;" 3 "optimized" } }
+! { dg-final { scan-tree-dump-not "return -1;" "optimized" } }
+
+integer function foo (x)
+  implicit none
+  integer, value :: x
+  integer :: y
+  !$omp assume holds (x == 42)
+    y = x;
+  !$omp end assume
+  foo = y
+end
+
+integer function bar (x)
+  implicit none
+  integer, value :: x
+  !$omp assume holds (x < 42)
+  block
+  end block
+  if (x == 42) then
+    bar = -1
+    return
+  end if
+  bar = 42
+end
+
+integer function foobar (y)
+  implicit none
+  integer, value :: y
+  !$omp assume holds(y > 5) holds (y < 7)
+  block
+    if (y == 6) then
+      foobar = 42
+      return
+    end if
+  end block
+  foobar = -1
+end

Re: [Patch] openmp: Map holds clause to IFN_ASSUME for Fortran

[Jakub Jelinek]

On Thu, Oct 06, 2022 at 12:55:01PM +0200, Tobias Burnus wrote:
> Same as for C/C++, albeit a tiny bit longer patch.
> 
> I don't know whether it makes sense to handle – in the long run – the
> case of se.pre/se.post being nonempty – and, if so, how.

I think it is essential not to throw those away,
if se.pre or se.post, you can e.g. expand it roughly as C/C++ ({ cond; }),
in GENERIC it can be say a TARGET_EXPR with a boolean
temporary as slot, where the the initializer will be the
se.pre part, followed by MODIFY_EXPR which sets the slot to se.expr
value and followed by se.post.
I've only started playing with the middle-end changes now, here
is what I have and plan to at lower_cf time turn that into essentially
bool artificial (args...)
{
  return cond;
}
and
.ASSUME (&artificial, args...);

--- gcc/gimplify.cc.jj	2022-10-06 08:56:28.344131629 +0200
+++ gcc/gimplify.cc	2022-10-06 14:04:46.647204910 +0200
@@ -3569,7 +3569,45 @@ gimplify_call_expr (tree *expr_p, gimple
 						     fndecl, 0));
 	      return GS_OK;
 	    }
-	  /* FIXME: Otherwise expand it specially.  */
+	  /* Temporarily, until gimple lowering, transform
+	     .ASSUME (cond);
+	     into:
+	     guard = .ASSUME ();
+	     if (guard) goto label_true; else label_false;
+	     label_true:;
+	     {
+	       guard = cond;
+	     }
+	     label_false:;
+	     .ASSUME (guard);
+	     such that gimple lowering can outline the condition into
+	     a separate function easily.  */
+	  tree guard = create_tmp_var (boolean_type_node);
+	  gcall *call = gimple_build_call_internal (ifn, 0);
+	  gimple_call_set_nothrow (call, TREE_NOTHROW (*expr_p));
+	  gimple_set_location (call, loc);
+	  gimple_call_set_lhs (call, guard);
+	  gimple_seq_add_stmt (pre_p, call);
+	  *expr_p = build2 (MODIFY_EXPR, void_type_node, guard,
+			    CALL_EXPR_ARG (*expr_p, 0));
+	  *expr_p = build3 (BIND_EXPR, void_type_node, NULL, *expr_p, NULL);
+	  tree label_false = create_artificial_label (UNKNOWN_LOCATION);
+	  tree label_true = create_artificial_label (UNKNOWN_LOCATION);
+	  gcond *cond_stmt = gimple_build_cond (NE_EXPR, guard,
+						boolean_false_node,
+						label_true, label_false);
+	  gimplify_seq_add_stmt (pre_p, cond_stmt);
+	  gimplify_seq_add_stmt (pre_p, gimple_build_label (label_true));
+	  push_gimplify_context ();
+	  gimple_seq body = NULL;
+	  gimple *g = gimplify_and_return_first (*expr_p, &body);
+	  pop_gimplify_context (g);
+	  gimplify_seq_add_seq (pre_p, body);
+	  gimplify_seq_add_stmt (pre_p, gimple_build_label (label_false));
+	  call = gimple_build_call_internal (ifn, 1, guard);
+	  gimple_call_set_nothrow (call, TREE_NOTHROW (*expr_p));
+	  gimple_set_location (call, loc);
+	  gimple_seq_add_stmt (pre_p, call);
 	  return GS_ALL_DONE;
 	}
 
--- gcc/cp/pt.cc.jj	2022-10-06 08:56:28.670127213 +0200
+++ gcc/cp/pt.cc	2022-10-06 13:42:26.632351930 +0200
@@ -21182,6 +21182,8 @@ tsubst_copy_and_build (tree t,
 		      ret = error_mark_node;
 		      break;
 		    }
+		  if (!processing_template_decl)
+		    arg = fold_build_cleanup_point_expr (TREE_TYPE (arg), arg);
 		  ret = build_call_expr_internal_loc (EXPR_LOCATION (t),
 						      IFN_ASSUME,
 						      void_type_node, 1,
--- gcc/cp/cp-gimplify.cc.jj	2022-10-06 08:56:28.660127349 +0200
+++ gcc/cp/cp-gimplify.cc	2022-10-06 13:41:54.286789968 +0200
@@ -3117,6 +3117,8 @@ process_stmt_assume_attribute (tree std_
 	    arg = contextual_conv_bool (arg, tf_warning_or_error);
 	  if (error_operand_p (arg))
 	    continue;
+	  if (!processing_template_decl)
+	    arg = fold_build_cleanup_point_expr (TREE_TYPE (arg), arg);
 	  statement = build_call_expr_internal_loc (attrs_loc, IFN_ASSUME,
 						    void_type_node, 1, arg);
 	  finish_expr_stmt (statement);
--- gcc/cp/parser.cc.jj	2022-10-06 10:39:31.989345921 +0200
+++ gcc/cp/parser.cc	2022-10-06 13:41:28.001145938 +0200
@@ -46029,6 +46029,8 @@ cp_parser_omp_assumption_clauses (cp_par
 		t = contextual_conv_bool (t, tf_warning_or_error);
 	      if (is_assume && !error_operand_p (t))
 		{
+		  if (!processing_template_decl)
+		    t = fold_build_cleanup_point_expr (TREE_TYPE (t), t);
 		  t = build_call_expr_internal_loc (eloc, IFN_ASSUME,
 						    void_type_node, 1, t);
 		  finish_expr_stmt (t);


	Jakub

Re: [Patch] openmp: Map holds clause to IFN_ASSUME for Fortran

[Tobias Burnus]

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

On 06.10.22 14:17, Jakub Jelinek wrote:
> On Thu, Oct 06, 2022 at 12:55:01PM +0200, Tobias Burnus wrote:
>> I don't know whether it makes sense to handle – in the long run – the
>> case of se.pre/se.post being nonempty – and, if so, how.
> I think it is essential not to throw those away,
> if se.pre or se.post, you can e.g. expand it roughly as C/C++ ({ cond; }),
> in GENERIC it can be say a TARGET_EXPR with a boolean
> temporary as slot, where the the initializer will be the
> se.pre part, followed by MODIFY_EXPR which sets the slot to se.expr
> value and followed by se.post.

Like as attached? – It did survive regtesting.

BTW: The assumption in assume-4.f90 does not help, but I think that's
expected. I wonder whether it will work in both cases after your
gimplify work.

Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: omp-assumes-hold-v2.diff --]
[-- Type: text/x-patch, Size: 5462 bytes --]

openmp: Map holds clause to IFN_ASSUME for Fortran

Same as r13-3107-g847f5addc4d07a2f3b95f5daa50ab4a64dfd957d did for C/C++.
Convert '!$omp assume holds(cond)' to IFN_ASSUME (cond).
    
gcc/fortran/
	* trans-openmp.cc (gfc_trans_omp_assume): New.
	(gfc_trans_omp_directive): Call it.

gcc/teststuite/
	* gfortran.dg/gomp/assume-3.f90: New test.
	* gfortran.dg/gomp/assume-4.f90: New test.

 gcc/fortran/trans-openmp.cc                 | 37 +++++++++++++++++++++-
 gcc/testsuite/gfortran.dg/gomp/assume-3.f90 | 46 +++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/gomp/assume-4.f90 | 48 +++++++++++++++++++++++++++++
 3 files changed, 130 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 21053694f81..8ea573f7d02 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4570,6 +4570,41 @@ gfc_trans_oacc_wait_directive (gfc_code *code)
 static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
 static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
 
+static tree
+gfc_trans_omp_assume (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_init_block (&block);
+  gfc_omp_assumptions *assume = code->ext.omp_clauses->assume;
+  if (assume)
+    for (gfc_expr_list *el = assume->holds; el; el = el->next)
+      {
+	location_t loc = gfc_get_location (&el->expr->where);
+	gfc_se se;
+	gfc_init_se (&se, NULL);
+	gfc_conv_expr (&se, el->expr);
+	tree t;
+	if (se.pre.head == NULL_TREE && se.post.head == NULL_TREE)
+	  t = se.expr;
+	else
+	  {
+	    tree var = gfc_create_var (TREE_TYPE (se.expr), NULL);
+	    stmtblock_t block2;
+	    gfc_init_block (&block2);
+	    gfc_add_block_to_block (&block2, &se.pre);
+	    gfc_add_modify_loc (loc, &block2, var, se.expr);
+	    gfc_add_block_to_block (&block2, &se.post);
+	    t = gfc_finish_block (&block2);
+	    t = build4 (TARGET_EXPR, boolean_type_node, var, t, NULL, NULL);
+	  }
+	t = build_call_expr_internal_loc (loc, IFN_ASSUME,
+					  void_type_node, 1, t);
+	gfc_add_expr_to_block (&block, t);
+      }
+  gfc_add_expr_to_block (&block, gfc_trans_omp_code (code->block->next, true));
+  return gfc_finish_block (&block);
+}
+
 static tree
 gfc_trans_omp_atomic (gfc_code *code)
 {
@@ -7488,7 +7523,7 @@ gfc_trans_omp_directive (gfc_code *code)
   switch (code->op)
     {
     case EXEC_OMP_ASSUME:
-      return gfc_trans_omp_code (code->block->next, true);
+      return gfc_trans_omp_assume (code);
     case EXEC_OMP_ATOMIC:
       return gfc_trans_omp_atomic (code);
     case EXEC_OMP_BARRIER:
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-3.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-3.f90
new file mode 100644
index 00000000000..e5deace306e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-3.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -O2 -fdump-tree-optimized -fdump-tree-original" }
+
+! { dg-final { scan-tree-dump-times ".ASSUME \\(x == 42\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(x <= 41\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(y <= 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(y > 5\\);" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "return 42;" 3 "optimized" } }
+! { dg-final { scan-tree-dump-not "return -1;" "optimized" } }
+
+integer function foo (x)
+  implicit none
+  integer, value :: x
+  integer :: y
+  !$omp assume holds (x == 42)
+    y = x;
+  !$omp end assume
+  foo = y
+end
+
+integer function bar (x)
+  implicit none
+  integer, value :: x
+  !$omp assume holds (x < 42)
+  block
+  end block
+  if (x == 42) then
+    bar = -1
+    return
+  end if
+  bar = 42
+end
+
+integer function foobar (y)
+  implicit none
+  integer, value :: y
+  !$omp assume holds(y > 5) holds (y < 7)
+  block
+    if (y == 6) then
+      foobar = 42
+      return
+    end if
+  end block
+  foobar = -1
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-4.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-4.f90
new file mode 100644
index 00000000000..f1f91924cea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-4.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -O2 -fdump-tree-original -fdump-tree-optimized" }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(i_lower_bound \\(\\) < i\\);" 1 "original" }
+! { dg-final { scan-tree-dump-times ".ASSUME \\(TARGET_EXPR <D.\[0-9\]+, D.\[0-9\]+ = j_upper_bound \\(\\);" 1 "original" }
+! { dg-final { scan-tree-dump-times "__builtin_free" 1 "original" }
+
+! { dg-final { scan-tree-dump-not "i_lower_bound" "optimized" }
+! { dg-final { scan-tree-dump-not "j_upper_bound" "optimized" }
+! { dg-final { scan-tree-dump-not "__builtin_free" "optimized" }
+
+! Note: Currently, the assumption does not help with optimization in either variant.
+
+  implicit none
+  integer, value :: i
+
+  !$omp assume holds(i > i_lower_bound ())
+  block
+    if (i > 4) then
+      f = 42
+    else
+      f = -1
+    end if
+  end block
+contains
+  function i_lower_bound ()
+    integer :: i_lower_bound
+    i_lower_bound = 5
+  end function
+end
+
+integer function g(j)
+  implicit none
+  integer, value :: j
+
+  !$omp assume holds(j < j_upper_bound ())
+  block
+    if (j < 10) then
+      g = 42
+    else
+      g = -1
+    end if
+  end block
+contains
+  function j_upper_bound ()
+    integer, allocatable :: j_upper_bound
+    j_upper_bound = 10
+  end function
+end

Re: [Patch] openmp: Map holds clause to IFN_ASSUME for Fortran

[Jakub Jelinek]

On Thu, Oct 06, 2022 at 06:15:52PM +0200, Tobias Burnus wrote:
> On 06.10.22 14:17, Jakub Jelinek wrote:
> > On Thu, Oct 06, 2022 at 12:55:01PM +0200, Tobias Burnus wrote:
> > > I don't know whether it makes sense to handle – in the long run – the
> > > case of se.pre/se.post being nonempty – and, if so, how.
> > I think it is essential not to throw those away,
> > if se.pre or se.post, you can e.g. expand it roughly as C/C++ ({ cond; }),
> > in GENERIC it can be say a TARGET_EXPR with a boolean
> > temporary as slot, where the the initializer will be the
> > se.pre part, followed by MODIFY_EXPR which sets the slot to se.expr
> > value and followed by se.post.
> 
> Like as attached? – It did survive regtesting.

LGTM, thanks.

> BTW: The assumption in assume-4.f90 does not help, but I think that's
> expected. I wonder whether it will work in both cases after your
> gimplify work.

Well, gimplify + gimple-lower but more importantly ranger work later on,
at least that's the hope...

	Jakub

[committed] openmp, fortran: Fix up IFN_ASSUME call

[Jakub Jelinek]

On Thu, Oct 06, 2022 at 06:15:52PM +0200, Tobias Burnus wrote:
> Like as attached? – It did survive regtesting.

Like in other spots in trans-openmp.cc that create a TARGET_EXPR, the
slot has to be created with create_tmp_var_raw, because gfc_create_var
adds the var to BLOCK_VARS and that ICEs during expansion because
gimple_add_tmp_var_fn has:
  gcc_assert (!DECL_CHAIN (tmp) && !DECL_SEEN_IN_BIND_EXPR_P (tmp));
assertion.  Also, both C/C++ ensure the argument to IFN_ASSUME has
boolean_type_node, it is easier if Fortran does that too.

Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk.

2022-10-10  Jakub Jelinek  <jakub@redhat.com>

	* trans-openmp.cc (gfc_trans_omp_assume): Use create_tmp_var_raw
	instead of gfc_create_var for TARGET_EXPR slot creation.  Create it
	with boolean_type_node and convert.

--- gcc/fortran/trans-openmp.cc.jj	2022-10-07 00:13:12.508191601 +0200
+++ gcc/fortran/trans-openmp.cc	2022-10-09 14:17:55.430364168 +0200
@@ -4588,11 +4588,14 @@ gfc_trans_omp_assume (gfc_code *code)
 	  t = se.expr;
 	else
 	  {
-	    tree var = gfc_create_var (TREE_TYPE (se.expr), NULL);
+	    tree var = create_tmp_var_raw (boolean_type_node);
+	    DECL_CONTEXT (var) = current_function_decl;
 	    stmtblock_t block2;
 	    gfc_init_block (&block2);
 	    gfc_add_block_to_block (&block2, &se.pre);
-	    gfc_add_modify_loc (loc, &block2, var, se.expr);
+	    gfc_add_modify_loc (loc, &block2, var,
+	    			fold_convert_loc (loc, boolean_type_node,
+						  se.expr));
 	    gfc_add_block_to_block (&block2, &se.post);
 	    t = gfc_finish_block (&block2);
 	    t = build4 (TARGET_EXPR, boolean_type_node, var, t, NULL, NULL);

	Jakub