Translate allocate directive (OpenMP 5.0).

Backport of a patch posted at
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html

gcc/fortran/ChangeLog:

	* trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
	(gfc_trans_omp_allocate): New function.
	(gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE.

gcc/ChangeLog:

	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
	(dump_generic_node): Handle OMP_ALLOCATE.
	* tree.def (OMP_ALLOCATE): New.
	* tree.h (OMP_ALLOCATE_CLAUSES): Likewise.
	(OMP_ALLOCATE_DECL): Likewise.
	(OMP_ALLOCATE_ALLOCATOR): Likewise.
	* tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-6.f90: New test.

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index 77c8f3929284220064366e1aed8a44d9584e5cdb..ffd4881022cb43cfed705b6cb6b150de4ac07047 100644 (file)
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,16 @@
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+       Backport of a patch posted at
+       https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
+
+       * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
+       (dump_generic_node): Handle OMP_ALLOCATE.
+       * tree.def (OMP_ALLOCATE): New.
+       * tree.h (OMP_ALLOCATE_CLAUSES): Likewise.
+       (OMP_ALLOCATE_DECL): Likewise.
+       (OMP_ALLOCATE_ALLOCATOR): Likewise.
+       * tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR.
+
 2022-03-08  Abid Qadeer  <abidh@codesourcery.com>
 
        * omp-low.c (omp_maybe_offloaded_ctx): New prototype.

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index a3fe0b74d6e6555b1e0a5298002fba82097b6812..df3d17f28f3ee617988f865ad9f7d99acadfd3dc 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+       Backport of a patch posted at
+       https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
+
+       * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
+       (gfc_trans_omp_allocate): New function.
+       (gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE.
+
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
        Backport of a patch posted at

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 6e225c61375f1674872bd41a21ef3b625094f25a..36787c2f088b57e7c43e95ed0bf523717fc01a57 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4036,6 +4036,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                  }
              }
          break;
+       case OMP_LIST_ALLOCATOR:
+         for (; n != NULL; n = n->next)
+           if (n->sym->attr.referenced)
+             {
+               tree t = gfc_trans_omp_variable (n->sym, false);
+               if (t != error_mark_node)
+                 {
+                   tree node = build_omp_clause (input_location,
+                                                 OMP_CLAUSE_ALLOCATOR);
+                   OMP_ALLOCATE_DECL (node) = t;
+                   if (n->expr)
+                     {
+                       tree allocator_;
+                       gfc_init_se (&se, NULL);
+                       gfc_conv_expr (&se, n->expr);
+                       allocator_ = gfc_evaluate_now (se.expr, block);
+                       OMP_ALLOCATE_ALLOCATOR (node) = allocator_;
+                     }
+                   omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+                 }
+             }
+         break;
        case OMP_LIST_LINEAR:
          {
            gfc_expr *last_step_expr = NULL;
@@ -6373,6 +6395,26 @@ gfc_trans_omp_atomic (gfc_code *code)
   return gfc_finish_block (&block);
 }
 
+static tree
+gfc_trans_omp_allocate (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt;
+
+  gfc_omp_clauses *clauses = code->ext.omp_clauses;
+  gcc_assert (clauses);
+
+  gfc_start_block (&block);
+  stmt = make_node (OMP_ALLOCATE);
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses,
+                                                      code->loc, false,
+                                                      true);
+  gfc_add_expr_to_block (&block, stmt);
+  gfc_merge_block_scope (&block);
+  return gfc_finish_block (&block);
+}
+
 static tree
 gfc_trans_omp_barrier (void)
 {
@@ -8907,6 +8949,8 @@ gfc_trans_omp_directive (gfc_code *code)
 {
   switch (code->op)
     {
+    case EXEC_OMP_ALLOCATE:
+      return gfc_trans_omp_allocate (code);
     case EXEC_OMP_ATOMIC:
       return gfc_trans_omp_atomic (code);
     case EXEC_OMP_BARRIER:

diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 9cfcd6482ebd8eb4c15a36e487f54529fa012dab..ae8c01822812809ddc4e0de422177a4a52e53d0d 100644 (file)
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,10 @@
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+       Backport of a patch posted at
+       https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
+
+       * gfortran.dg/gomp/allocate-6.f90: New test.
+
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
        Backport of a patch posted at

diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
new file mode 100644 (file)
index 0000000..2de2b52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -0,0 +1,72 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+module omp_lib_kinds
+  use iso_c_binding, only: c_int, c_intptr_t
+  implicit none
+  private :: c_int, c_intptr_t
+  integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_null_allocator = 0
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_default_mem_alloc = 1
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_large_cap_mem_alloc = 2
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_const_mem_alloc = 3
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_high_bw_mem_alloc = 4
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_low_lat_mem_alloc = 5
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_cgroup_mem_alloc = 6
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_pteam_mem_alloc = 7
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_thread_mem_alloc = 8
+end module
+
+
+subroutine foo(x, y, al)
+  use omp_lib_kinds
+  implicit none
+  
+type :: my_type
+  integer :: i
+  integer :: j
+  real :: x
+end type
+
+  integer  :: x
+  integer  :: y
+  integer (kind=omp_allocator_handle_kind) :: al
+
+  integer, allocatable :: var1
+  integer, allocatable :: var2
+  real, allocatable :: var3(:,:)
+  type (my_type), allocatable :: var4
+  integer, pointer :: pii, parr(:)
+
+  character, allocatable :: str1a, str1aarr(:) 
+  character(len=5), allocatable :: str5a, str5aarr(:)
+  
+  !$omp allocate
+  allocate(str1a, str1aarr(10), str5a, str5aarr(10))
+
+  !$omp allocate (var1) allocator(omp_default_mem_alloc)
+  !$omp allocate (var2) allocator(omp_large_cap_mem_alloc)
+  allocate (var1, var2)
+
+  !$omp allocate (var4)  allocator(omp_low_lat_mem_alloc)
+  allocate (var4)
+  var4%i = 5
+
+  !$omp allocate (var3)  allocator(omp_low_lat_mem_alloc)
+  allocate (var3(x,y))
+
+  !$omp allocate
+  allocate(pii, parr(5))
+end subroutine
+
+! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } }

diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 162c25d28559d3fbc49a85e003188d9626663c9b..e2c641f93912b52d4147e662c58aa8fc5500139a 100644 (file)
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -513,7 +513,10 @@ enum omp_clause_code {
   OMP_CLAUSE_IF_PRESENT,
 
   /* OpenACC clause: finalize.  */
-  OMP_CLAUSE_FINALIZE
+  OMP_CLAUSE_FINALIZE,
+
+  /* OpenMP clause: allocator.  */
+  OMP_CLAUSE_ALLOCATOR
 };
 
 #undef DEFTREESTRUCT

diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index f41587fa21d719225dafcab8ef7243f471504553..dfc7624874b1192f162f051e64f4832cde6eb8b2 100644 (file)
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -731,6 +731,20 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
       pp_right_paren (pp);
       break;
 
+    case OMP_CLAUSE_ALLOCATOR:
+      pp_string (pp, "(");
+      dump_generic_node (pp, OMP_ALLOCATE_DECL (clause),
+                        spc, flags, false);
+      if (OMP_ALLOCATE_ALLOCATOR (clause))
+       {
+         pp_string (pp, ":allocator(");
+         dump_generic_node (pp, OMP_ALLOCATE_ALLOCATOR (clause),
+                            spc, flags, false);
+         pp_right_paren (pp);
+       }
+      pp_right_paren (pp);
+      break;
+
     case OMP_CLAUSE_ALLOCATE:
       pp_string (pp, "allocate(");
       if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (clause))
@@ -3522,6 +3536,11 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
       dump_omp_clauses (pp, OACC_CACHE_CLAUSES (node), spc, flags);
       break;
 
+    case OMP_ALLOCATE:
+      pp_string (pp, "#pragma omp allocate ");
+      dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags);
+      break;
+
     case OMP_PARALLEL:
       pp_string (pp, "#pragma omp parallel");
       dump_omp_clauses (pp, OMP_PARALLEL_CLAUSES (node), spc, flags);

diff --git a/gcc/tree.c b/gcc/tree.c
index 9146d3e06de622f721eab12592e6cc3c8a9cf736..26830f47aa1b6a9593c487b802e486d0cf0916c6 100644 (file)
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -364,6 +364,7 @@ unsigned const char omp_clause_num_ops[] =
   3, /* OMP_CLAUSE_TILE  */
   0, /* OMP_CLAUSE_IF_PRESENT */
   0, /* OMP_CLAUSE_FINALIZE */
+  2, /* OMP_CLAUSE_ALLOCATOR */
 };
 
 const char * const omp_clause_code_name[] =

diff --git a/gcc/tree.def b/gcc/tree.def
index 91f8c4db1e373fbe73dcefaf982a267f2915d430..ec80d52f7b2015d12d30f4ba5dc043a95d958d49 100644 (file)
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1306,6 +1306,10 @@ DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1)
 DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2)
 DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2)
 
+/* OpenMP - #pragma omp allocate
+   Operand 0: Clauses.  */
+DEFTREECODE (OMP_ALLOCATE, "omp allocate", tcc_statement, 1)
+
 /* OpenMP clauses.  */
 DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0)
 

diff --git a/gcc/tree.h b/gcc/tree.h
index 6b63e2e0f5256240038fae7371c95609edbe999c..57fa20193163f7f8250bbac2cc5c7576f6b7538b 100644 (file)
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1399,6 +1399,8 @@ class auto_suppress_location_wrappers
 #define OACC_UPDATE_CLAUSES(NODE) \
   TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
 
+#define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0)
+
 #define OMP_PARALLEL_BODY(NODE)    TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0)
 #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1)
 
@@ -1811,6 +1813,15 @@ class auto_suppress_location_wrappers
 #define OMP_CLAUSE_ALLOCATE_ALIGN(NODE) \
   OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE), 2)
 
+/* May be we can use OMP_CLAUSE_DECL but the I am not sure where to place
+   OMP_CLAUSE_ALLOCATOR in omp_clause_code.  */
+
+#define OMP_ALLOCATE_DECL(NODE) \
+  OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 0)
+
+#define OMP_ALLOCATE_ALLOCATOR(NODE) \
+  OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 1)
+
 /* True if an ALLOCATE clause was present on a combined or composite
    construct and the code for splitting the clauses has already performed
    checking if the listed variable has explicit privatization on the