Lower allocate directive (OpenMP 5.0).

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

This patch looks for malloc/free calls that were generated by allocate statement
that is associated with allocate directive and replaces them with GOMP_alloc
and GOMP_free.

gcc/ChangeLog:

	* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_ALLOCATOR.
	(scan_omp_allocate): New.
	(scan_omp_1_stmt): Call it.
	(lower_omp_allocate): New function.
	(lower_omp_1): Call it.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-6.f90: Add tests.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/allocate-2.f90: New test.
	* gfortran.dg/gomp/allocate-7.f90: New test.
	* gfortran.dg/gomp/allocate-8.f90: New test.

8 files changed, 251 insertions, 0 deletions

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index 8390f83..c6c60c2 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,6 +1,17 @@
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
 	Backport of a patch posted at
+	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588372.html
+
+	* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_ALLOCATOR.
+	(scan_omp_allocate): New.
+	(scan_omp_1_stmt): Call it.
+	(lower_omp_allocate): New function.
+	(lower_omp_1): Call it.
+
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+	Backport of a patch posted at
 	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588371.html
 
 	* doc/gimple.texi: Describe GIMPLE_OMP_ALLOCATE.
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 5e1649f..16a986e 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1983,6 +1983,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
 	case OMP_CLAUSE_FINALIZE:
 	case OMP_CLAUSE_TASK_REDUCTION:
 	case OMP_CLAUSE_ALLOCATE:
+	case OMP_CLAUSE_ALLOCATOR:
 	  break;
 
 	case OMP_CLAUSE_ALIGNED:
@@ -2197,6 +2198,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
 	case OMP_CLAUSE_FINALIZE:
 	case OMP_CLAUSE_FILTER:
 	case OMP_CLAUSE__CONDTEMP_:
+	case OMP_CLAUSE_ALLOCATOR:
 	  break;
 
 	case OMP_CLAUSE_NOHOST:
@@ -3294,6 +3296,16 @@ scan_omp_simd_scan (gimple_stmt_iterator *gsi, gomp_for *stmt,
   maybe_lookup_ctx (new_stmt)->for_simd_scan_phase = true;
 }
 
+/* Scan an OpenMP allocate directive.  */
+
+static void
+scan_omp_allocate (gomp_allocate *stmt, omp_context *outer_ctx)
+{
+  omp_context *ctx;
+  ctx = new_omp_context (stmt, outer_ctx);
+  scan_sharing_clauses (gimple_omp_allocate_clauses (stmt), ctx);
+}
+
 /* Scan an OpenMP sections directive.  */
 
 static void
@@ -4725,6 +4737,9 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
 	    insert_decl_map (&ctx->cb, var, var);
       }
       break;
+    case GIMPLE_OMP_ALLOCATE:
+      scan_omp_allocate (as_a <gomp_allocate *> (stmt), ctx);
+      break;
     default:
       *handled_ops_p = false;
       break;
@@ -9231,6 +9246,121 @@ lower_omp_single_simple (gomp_single *single_stmt, gimple_seq *pre_p)
   gimple_seq_add_stmt (pre_p, gimple_build_label (flabel));
 }
 
+static void
+lower_omp_allocate (gimple_stmt_iterator *gsi_p, omp_context *ctx)
+{
+  gomp_allocate *st = as_a <gomp_allocate *> (gsi_stmt (*gsi_p));
+  tree clauses = gimple_omp_allocate_clauses (st);
+  int kind = gimple_omp_allocate_kind (st);
+  gcc_assert (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE
+	      || kind == GF_OMP_ALLOCATE_KIND_FREE);
+  bool allocate = (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE);
+
+  for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+    {
+      if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_ALLOCATOR)
+	continue;
+
+      /* The allocate directives that appear in a target region must specify
+	 an allocator clause unless a requires directive with the
+	 dynamic_allocators clause is present in the same compilation unit.  */
+      if (OMP_ALLOCATE_ALLOCATOR (c) == NULL_TREE
+	  && ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0)
+	  && omp_maybe_offloaded_ctx (ctx))
+	error_at (OMP_CLAUSE_LOCATION (c), "%<allocate%> directive must"
+		  " specify an allocator here");
+
+      tree var = OMP_ALLOCATE_DECL (c);
+
+      gimple_stmt_iterator gsi = *gsi_p;
+      for (gsi_next (&gsi); !gsi_end_p (gsi); gsi_next (&gsi))
+	{
+	  gimple *stmt = gsi_stmt (gsi);
+
+	  if (gimple_code (stmt) != GIMPLE_CALL
+	      || (allocate && gimple_call_fndecl (stmt)
+		  != builtin_decl_explicit (BUILT_IN_MALLOC))
+	      || (!allocate && gimple_call_fndecl (stmt)
+		  != builtin_decl_explicit (BUILT_IN_FREE)))
+	    continue;
+	  const gcall *gs = as_a <const gcall *> (stmt);
+	  tree allocator = OMP_ALLOCATE_ALLOCATOR (c)
+			   ? OMP_ALLOCATE_ALLOCATOR (c)
+			   : integer_zero_node;
+	  if (allocate)
+	    {
+	      tree lhs = gimple_call_lhs (gs);
+	      if (lhs && TREE_CODE (lhs) == SSA_NAME)
+		{
+		  gimple_stmt_iterator gsi2 = gsi;
+		  gsi_next (&gsi2);
+		  gimple *assign = gsi_stmt (gsi2);
+		  if (gimple_code (assign) == GIMPLE_ASSIGN)
+		    {
+		      lhs = gimple_assign_lhs (as_a <const gassign *> (assign));
+		      if (lhs == NULL_TREE
+			  || TREE_CODE (lhs) != COMPONENT_REF)
+			continue;
+		      lhs = TREE_OPERAND (lhs, 0);
+		    }
+		}
+
+	      if (lhs == var)
+		{
+		  unsigned HOST_WIDE_INT ialign = 0;
+		  tree align;
+		  if (TYPE_P (var))
+		    ialign = TYPE_ALIGN_UNIT (var);
+		  else
+		    ialign = DECL_ALIGN_UNIT (var);
+		  align = build_int_cst (size_type_node, ialign);
+		  tree repl = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC);
+		  tree size = gimple_call_arg (gs, 0);
+		  gimple *g = gimple_build_call (repl, 3, align, size,
+						 allocator);
+		  gimple_call_set_lhs (g, gimple_call_lhs (gs));
+		  gimple_set_location (g, gimple_location (stmt));
+		  gsi_replace (&gsi, g, true);
+		}
+	    }
+	  else
+	    {
+	      tree arg = gimple_call_arg (gs, 0);
+	      if (arg && TREE_CODE (arg) == SSA_NAME)
+		{
+		  gimple_stmt_iterator gsi2 = gsi;
+		  gsi_prev (&gsi2);
+		  if (!gsi_end_p (gsi2))
+		    {
+		      gimple *gs = gsi_stmt (gsi2);
+		      if (gimple_code (gs) == GIMPLE_ASSIGN)
+			{
+			  const gassign *assign = as_a <const gassign *> (gs);
+			  tree rhs = gimple_assign_rhs1 (assign);
+			  tree lhs = gimple_assign_lhs (assign);
+			  if (lhs == arg && rhs
+			      && TREE_CODE (rhs) == COMPONENT_REF)
+			      arg = TREE_OPERAND (rhs, 0);
+			}
+		    }
+		}
+
+	      if (arg == var)
+		{
+		  tree repl = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
+		  gimple *g = gimple_build_call (repl, 2,
+						 gimple_call_arg (gs, 0),
+						 allocator);
+		  gimple_set_location (g, gimple_location (stmt));
+		  gsi_replace (&gsi, g, true);
+		  break;
+		}
+	    }
+	}
+    }
+  gsi_replace (gsi_p, gimple_build_nop (), true);
+}
+
 
 /* A subroutine of lower_omp_single.  Expand the simple form of
    a GIMPLE_OMP_SINGLE, with a copyprivate clause:
@@ -15038,6 +15168,11 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
       gcc_assert (ctx);
       lower_omp_scope (gsi_p, ctx);
       break;
+    case GIMPLE_OMP_ALLOCATE:
+      ctx = maybe_lookup_ctx (stmt);
+      gcc_assert (ctx);
+      lower_omp_allocate (gsi_p, ctx);
+      break;
     case GIMPLE_OMP_SINGLE:
       ctx = maybe_lookup_ctx (stmt);
       gcc_assert (ctx);
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index ab42f1d..23b5adc 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,6 +1,15 @@
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
 	Backport of a patch posted at
+	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588372.html
+
+	* gfortran.dg/gomp/allocate-6.f90: Add tests.
+	* gfortran.dg/gomp/allocate-7.f90: New test.
+	* gfortran.dg/gomp/allocate-8.f90: New test.
+
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+	Backport of a patch posted at
 	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588371.html
 
 	* gfortran.dg/gomp/allocate-6.f90: Add tests.
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
index 6957bc5..738d993 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -1,5 +1,6 @@
 ! { dg-do compile }
 ! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" }
+! { dg-additional-options "-fdump-tree-omplower" }
 
 module omp_lib_kinds
   use iso_c_binding, only: c_int, c_intptr_t
@@ -47,6 +48,7 @@ end type
   real, allocatable :: var3(:,:)
   type (my_type), allocatable :: var4
   integer, pointer :: pii, parr(:)
+  integer, allocatable :: var
 
   character, allocatable :: str1a, str1aarr(:) 
   character(len=5), allocatable :: str5a, str5aarr(:)
@@ -67,9 +69,16 @@ end type
 
   !$omp allocate
   allocate(pii, parr(5))
+
+  ! allocate statement not associated with an allocate directive
+  allocate(var)
 end subroutine
 
 ! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } }
 ! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "gimple" } }
 ! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "gimple" } }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 11 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 9 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_alloc" 10 "omplower" } }
+! { dg-final { scan-tree-dump-times "GOMP_free" 8 "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
new file mode 100644
index 0000000..db76e90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+
+subroutine bar(a)
+  implicit none
+  integer  :: a
+  integer, allocatable :: var
+!$omp target
+  !$omp allocate (var) ! { dg-error "'allocate' directive must specify an allocator here" }
+  allocate (var)
+!$omp end target
+
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90
new file mode 100644
index 0000000..699a3b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+
+subroutine bar(a)
+  implicit none
+  integer  :: a
+  integer, allocatable :: var
+!$omp requires dynamic_allocators
+!$omp target
+  !$omp allocate (var)
+  allocate (var)
+!$omp end target
+
+end subroutine
+
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 0c13a86..76b365e 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/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/588372.html
+
+	* testsuite/libgomp.fortran/allocate-2.f90: New test.
+
 2022-03-08  Abid Qadeer  <abidh@codesourcery.com>
 
 	* testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-2.f90 b/libgomp/testsuite/libgomp.fortran/allocate-2.f90
new file mode 100644
index 0000000..fdd69d7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-2.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-additional-sources allocate-1.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+  use omp_lib
+  use iso_c_binding
+  implicit none
+  interface
+    integer(c_int) function is_64bit_aligned (a) bind(C)
+      import :: c_int
+      integer  :: a
+    end
+  end interface
+
+contains
+
+subroutine foo (x, y, h)
+  use omp_lib
+  !use iso_c_binding
+  integer  :: x
+  integer  :: y
+  integer (kind=omp_allocator_handle_kind) :: h
+  integer, allocatable :: var1
+  !integer, allocatable :: var2(:)
+
+  !$omp allocate (var1)  allocator(h)
+  allocate (var1)
+
+  !y = 1
+  if (is_64bit_aligned(var1) == 0) then
+    stop 19
+  end if
+
+end subroutine
+end module m
+
+program main
+  use omp_lib
+  use m
+  type (omp_alloctrait) :: traits(3)
+  integer (omp_allocator_handle_kind) :: a
+
+  traits = [omp_alloctrait (omp_atk_alignment, 64), &
+            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+            omp_alloctrait (omp_atk_pool_size, 8192)]
+  a = omp_init_allocator (omp_default_mem_space, 3, traits)
+  if (a == omp_null_allocator) stop 1
+  !call omp_set_default_allocator (omp_default_mem_alloc);
+  call foo (42, 12, a);
+  call omp_destroy_allocator (a);
+end