From: Tobias Burnus <tobias@codesourcery.com>
Date: Thu, 22 Oct 2020 15:09:22 +0000 (+0200)
Subject: OpenMP: Fortran - support omp flush's memorder clauses
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c26d7df103197e52dcd6edbb9a7f58eafdd6c715;p=gcc.git

OpenMP: Fortran - support omp flush's memorder clauses

gcc/fortran/ChangeLog:

	* gfortran.h (enum gfc_omp_memorder): Add.
	(gfc_omp_clauses): Use it.
	* openmp.c (gfc_match_omp_flush): Match memorder clauses.
	* trans-openmp.c (gfc_trans_omp_flush): Handle them.
	(gfc_trans_omp_directive): Update call.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/flush-1.f90: New test.
	* gfortran.dg/gomp/flush-2.f90: New test.
---

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d0cea838444..931b908a16e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1361,6 +1361,14 @@ enum gfc_omp_requires_kind
 				   | OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
 };
 
+enum gfc_omp_memorder
+{
+  OMP_MEMORDER_ACQ_REL,
+  OMP_MEMORDER_RELEASE,
+  OMP_MEMORDER_ACQUIRE,
+  OMP_MEMORDER_LAST
+};
+
 typedef struct gfc_omp_clauses
 {
   struct gfc_expr *if_expr;
@@ -1376,6 +1384,7 @@ typedef struct gfc_omp_clauses
   bool inbranch, notinbranch, defaultmap, nogroup;
   bool sched_simd, sched_monotonic, sched_nonmonotonic;
   bool simd, threads, depend_source, order_concurrent;
+  enum gfc_omp_memorder memorder;
   enum gfc_omp_cancel_kind cancel;
   enum gfc_omp_proc_bind_kind proc_bind;
   struct gfc_expr *safelen_expr;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1efce33e519..b143ba7454a 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2766,15 +2766,44 @@ match
 gfc_match_omp_flush (void)
 {
   gfc_omp_namelist *list = NULL;
+  gfc_omp_clauses *c = NULL;
+  gfc_gobble_whitespace ();
+  enum gfc_omp_memorder mo = OMP_MEMORDER_LAST;
+  if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(')
+    {
+      if (gfc_match ("acq_rel") == MATCH_YES)
+	mo = OMP_MEMORDER_ACQ_REL;
+      else if (gfc_match ("release") == MATCH_YES)
+	mo = OMP_MEMORDER_RELEASE;
+      else if (gfc_match ("acquire") == MATCH_YES)
+	mo = OMP_MEMORDER_ACQUIRE;
+      else
+	{
+	  gfc_error ("Expected AQC_REL, RELEASE, or ACQUIRE at %C");
+	  return MATCH_ERROR;
+	}
+      c = gfc_get_omp_clauses ();
+      c->memorder = mo;
+    }
   gfc_match_omp_variable_list (" (", &list, true);
+  if (list && mo != OMP_MEMORDER_LAST)
+    {
+      gfc_error ("List specified together with memory order clause in FLUSH "
+		 "directive at %C");
+      gfc_free_omp_namelist (list);
+      gfc_free_omp_clauses (c);
+      return MATCH_ERROR;
+    }
   if (gfc_match_omp_eos () != MATCH_YES)
     {
       gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
       gfc_free_omp_namelist (list);
+      gfc_free_omp_clauses (c);
       return MATCH_ERROR;
     }
   new_st.op = EXEC_OMP_FLUSH;
   new_st.ext.omp_namelist = list;
+  new_st.ext.omp_clauses = c;
   return MATCH_YES;
 }
 
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 378088a9d04..bd7e13d748e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -38,6 +38,8 @@ along with GCC; see the file COPYING3.  If not see
 #include "gomp-constants.h"
 #include "omp-general.h"
 #include "omp-low.h"
+#include "memmodel.h"  /* For MEMMODEL_ enums.  */
+
 #undef GCC_DIAG_STYLE
 #define GCC_DIAG_STYLE __gcc_tdiag__
 #include "diagnostic-core.h"
@@ -4785,10 +4787,30 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
 }
 
 static tree
-gfc_trans_omp_flush (void)
+gfc_trans_omp_flush (gfc_code *code)
 {
-  tree decl = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
-  return build_call_expr_loc (input_location, decl, 0);
+  tree call;
+  if (!code->ext.omp_clauses
+      || code->ext.omp_clauses->memorder == OMP_MEMORDER_LAST)
+    {
+      call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
+      call = build_call_expr_loc (input_location, call, 0);
+    }
+  else
+    {
+      enum memmodel mo = MEMMODEL_LAST;
+      switch (code->ext.omp_clauses->memorder)
+	{
+	case OMP_MEMORDER_ACQ_REL: mo = MEMMODEL_ACQ_REL; break;
+	case OMP_MEMORDER_RELEASE: mo = MEMMODEL_RELEASE; break;
+	case OMP_MEMORDER_ACQUIRE: mo = MEMMODEL_ACQUIRE; break;
+	default: gcc_unreachable (); break;
+	}
+      call = builtin_decl_explicit (BUILT_IN_ATOMIC_THREAD_FENCE);
+      call = build_call_expr_loc (input_location, call, 1,
+				  build_int_cst (integer_type_node, mo));
+    }
+  return call;
 }
 
 static tree
@@ -6033,7 +6055,7 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_DO_SIMD:
       return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
     case EXEC_OMP_FLUSH:
-      return gfc_trans_omp_flush ();
+      return gfc_trans_omp_flush (code);
     case EXEC_OMP_MASTER:
       return gfc_trans_omp_master (code);
     case EXEC_OMP_ORDERED:
diff --git a/gcc/testsuite/gfortran.dg/gomp/flush-1.f90 b/gcc/testsuite/gfortran.dg/gomp/flush-1.f90
new file mode 100644
index 00000000000..d0b7f9eb82d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/flush-1.f90
@@ -0,0 +1,41 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-final { scan-tree-dump "foo \\(4\\);\[\n\r]*  __atomic_thread_fence \\(4\\);\[\n\r]*  foo \\(4\\);" "gimple" } }
+! { dg-final { scan-tree-dump "foo \\(3\\);\[\n\r]*  __atomic_thread_fence \\(3\\);\[\n\r]*  foo \\(3\\);" "gimple" } }
+! { dg-final { scan-tree-dump "foo \\(2\\);\[\n\r]*  __atomic_thread_fence \\(2\\);\[\n\r]*  foo \\(2\\);" "gimple" } }
+! { dg-final { scan-tree-dump "foo \\(5\\);\[\n\r]*  __sync_synchronize \\(\\);\[\n\r]*  foo \\(5\\);" "gimple" } }
+
+module m
+  interface
+    subroutine foo(x)
+      integer, value :: x
+    end
+  end interface
+end module m
+
+subroutine f1
+  use m
+  call foo (4)
+  !$omp flush acq_rel
+  call foo (4)
+end
+
+subroutine f2
+  use m
+  call foo (3)
+  !$omp flush release
+  call foo (3)
+end
+
+subroutine f3
+  use m
+  call foo (2)
+  !$omp flush acquire
+  call foo (2)
+end
+
+subroutine f4
+  use m
+  call foo (5)
+  !$omp flush
+  call foo (5)
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 b/gcc/testsuite/gfortran.dg/gomp/flush-2.f90
new file mode 100644
index 00000000000..68573711649
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/flush-2.f90
@@ -0,0 +1,18 @@
+module m
+  integer :: a, b
+end module m
+
+subroutine foo (void)
+  use m
+  !$omp flush
+  !$omp flush (a, b)
+  !$omp flush acquire
+  !$omp flush release
+  !$omp flush acq_rel
+  !$omp flush relaxed		! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" }
+  !$omp flush seq_cst		! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" }
+  !$omp flush foobar		! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" }
+  !$omp flush acquire (a, b)	! { dg-error "List specified together with memory order clause in FLUSH directive" }
+  !$omp flush release (a, b)	! { dg-error "List specified together with memory order clause in FLUSH directive" }
+  !$omp flush acq_rel (a, b)	! { dg-error "List specified together with memory order clause in FLUSH directive" }
+end