[PATCH 4/5] [gfortran] Gimplify allocate directive (OpenMP 5.0).

[Hafiz Abid Qadeer <abidh@codesourcery.com>]

gcc/ChangeLog:

	* doc/gimple.texi: Describe GIMPLE_OMP_ALLOCATE.
	* gimple-pretty-print.c (dump_gimple_omp_allocate): New function.
	(pp_gimple_stmt_1): Call it.
	* gimple.c (gimple_build_omp_allocate): New function.
	* gimple.def (GIMPLE_OMP_ALLOCATE): New node.
	* gimple.h (enum gf_mask): Add GF_OMP_ALLOCATE_KIND_MASK,
	GF_OMP_ALLOCATE_KIND_ALLOCATE and GF_OMP_ALLOCATE_KIND_FREE.
	(struct gomp_allocate): New.
	(is_a_helper <gomp_allocate *>::test): New.
	(is_a_helper <const gomp_allocate *>::test): New.
	(gimple_build_omp_allocate): Declare.
	(gimple_omp_subcode): Replace GIMPLE_OMP_TEAMS with
	GIMPLE_OMP_ALLOCATE.
	(gimple_omp_allocate_set_clauses): New.
	(gimple_omp_allocate_set_kind): Likewise.
	(gimple_omp_allocate_clauses): Likewise.
	(gimple_omp_allocate_kind): Likewise.
	(CASE_GIMPLE_OMP): Add GIMPLE_OMP_ALLOCATE.
	* gimplify.c (gimplify_omp_allocate): New.
	(gimplify_expr): Call it.
	* gsstruct.def (GSS_OMP_ALLOCATE): Define.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-6.f90: Add tests.
---
 gcc/doc/gimple.texi                           | 38 +++++++++++-
 gcc/gimple-pretty-print.c                     | 37 ++++++++++++
 gcc/gimple.c                                  | 10 ++++
 gcc/gimple.def                                |  6 ++
 gcc/gimple.h                                  | 60 ++++++++++++++++++-
 gcc/gimplify.c                                | 19 ++++++
 gcc/gsstruct.def                              |  1 +
 gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 |  4 +-
 8 files changed, 171 insertions(+), 4 deletions(-)

diff --git a/gcc/doc/gimple.texi b/gcc/doc/gimple.texi
index 65ef63d6ee9..60a4d2c17ca 100644
--- a/gcc/doc/gimple.texi
+++ b/gcc/doc/gimple.texi
@@ -420,6 +420,9 @@ kinds, along with their relationships to @code{GSS_} values (layouts) and
      + gomp_continue
      |        layout: GSS_OMP_CONTINUE, code: GIMPLE_OMP_CONTINUE
      |
+     + gomp_allocate
+     |        layout: GSS_OMP_ALLOCATE, code: GIMPLE_OMP_ALLOCATE
+     |
      + gomp_atomic_load
      |        layout: GSS_OMP_ATOMIC_LOAD, code: GIMPLE_OMP_ATOMIC_LOAD
      |
@@ -454,6 +457,7 @@ The following table briefly describes the GIMPLE instruction set.
 @item @code{GIMPLE_GOTO}		@tab x			@tab x
 @item @code{GIMPLE_LABEL}		@tab x			@tab x
 @item @code{GIMPLE_NOP}			@tab x			@tab x
+@item @code{GIMPLE_OMP_ALLOCATE}	@tab x			@tab x
 @item @code{GIMPLE_OMP_ATOMIC_LOAD}	@tab x			@tab x
 @item @code{GIMPLE_OMP_ATOMIC_STORE}	@tab x			@tab x
 @item @code{GIMPLE_OMP_CONTINUE}	@tab x			@tab x
@@ -1029,6 +1033,7 @@ Return a deep copy of statement @code{STMT}.
 * @code{GIMPLE_LABEL}::
 * @code{GIMPLE_GOTO}::
 * @code{GIMPLE_NOP}::
+* @code{GIMPLE_OMP_ALLOCATE}::
 * @code{GIMPLE_OMP_ATOMIC_LOAD}::
 * @code{GIMPLE_OMP_ATOMIC_STORE}::
 * @code{GIMPLE_OMP_CONTINUE}::
@@ -1729,6 +1734,38 @@ Build a @code{GIMPLE_NOP} statement.
 Returns @code{TRUE} if statement @code{G} is a @code{GIMPLE_NOP}.
 @end deftypefn
 
+@node @code{GIMPLE_OMP_ALLOCATE}
+@subsection @code{GIMPLE_OMP_ALLOCATE}
+@cindex @code{GIMPLE_OMP_ALLOCATE}
+
+@deftypefn {GIMPLE function} gomp_allocate *gimple_build_omp_allocate ( @
+tree clauses, int kind)
+Build a @code{GIMPLE_OMP_ALLOCATE} statement.  @code{CLAUSES} is the clauses
+associated with this node.  @code{KIND} is the enumeration value
+@code{GF_OMP_ALLOCATE_KIND_ALLOCATE} if this directive allocates memory
+or @code{GF_OMP_ALLOCATE_KIND_FREE} if it de-allocates.
+@end deftypefn
+
+@deftypefn {GIMPLE function} void gimple_omp_allocate_set_clauses ( @
+gomp_allocate *g, tree clauses)
+Set the @code{CLAUSES} for a @code{GIMPLE_OMP_ALLOCATE}.
+@end deftypefn
+
+@deftypefn {GIMPLE function} tree gimple_omp_aallocate_clauses ( @
+const gomp_allocate *g)
+Get the @code{CLAUSES} of a @code{GIMPLE_OMP_ALLOCATE}.
+@end deftypefn
+
+@deftypefn {GIMPLE function} void gimple_omp_allocate_set_kind ( @
+gomp_allocate *g, int kind)
+Set the @code{KIND} for a @code{GIMPLE_OMP_ALLOCATE}.
+@end deftypefn
+
+@deftypefn {GIMPLE function} tree gimple_omp_allocate_kind ( @
+const gomp_atomic_load *g)
+Get the @code{KIND} of a @code{GIMPLE_OMP_ALLOCATE}.
+@end deftypefn
+
 @node @code{GIMPLE_OMP_ATOMIC_LOAD}
 @subsection @code{GIMPLE_OMP_ATOMIC_LOAD}
 @cindex @code{GIMPLE_OMP_ATOMIC_LOAD}
@@ -1760,7 +1797,6 @@ const gomp_atomic_load *g)
 Get the @code{RHS} of an atomic set.
 @end deftypefn
 
-
 @node @code{GIMPLE_OMP_ATOMIC_STORE}
 @subsection @code{GIMPLE_OMP_ATOMIC_STORE}
 @cindex @code{GIMPLE_OMP_ATOMIC_STORE}
diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c
index ebd87b20a0a..bb961a900df 100644
--- a/gcc/gimple-pretty-print.c
+++ b/gcc/gimple-pretty-print.c
@@ -1967,6 +1967,38 @@ dump_gimple_omp_critical (pretty_printer *buffer, const gomp_critical *gs,
     }
 }
 
+static void
+dump_gimple_omp_allocate (pretty_printer *buffer, const gomp_allocate *gs,
+			  int spc, dump_flags_t flags)
+{
+  if (flags & TDF_RAW)
+    {
+      const char *kind="";
+      switch (gimple_omp_allocate_kind (gs))
+      {
+	case GF_OMP_ALLOCATE_KIND_ALLOCATE:
+	  kind = "allocate";
+	  break;
+	case GF_OMP_ALLOCATE_KIND_FREE:
+	  kind = "free";
+	  break;
+      }
+    dump_gimple_fmt (buffer, spc, flags, "%G <kind:%s CLAUSES <", gs, kind);
+    dump_omp_clauses (buffer, gimple_omp_allocate_clauses (gs), spc, flags);
+    dump_gimple_fmt (buffer, spc, flags, " > >");
+    }
+  else
+    {
+      pp_string (buffer, "#pragma omp allocate ");
+      if (gimple_omp_allocate_kind (gs) == GF_OMP_ALLOCATE_KIND_ALLOCATE)
+	pp_string (buffer, "(kind=allocate) ");
+      else if (gimple_omp_allocate_kind (gs) == GF_OMP_ALLOCATE_KIND_FREE)
+	pp_string (buffer, "(kind=free) ");
+
+      dump_omp_clauses (buffer, gimple_omp_allocate_clauses (gs), spc, flags);
+    }
+}
+
 /* Dump a GIMPLE_OMP_ORDERED tuple on the pretty_printer BUFFER.  */
 
 static void
@@ -2823,6 +2855,11 @@ pp_gimple_stmt_1 (pretty_printer *buffer, const gimple *gs, int spc,
 				flags);
       break;
 
+    case GIMPLE_OMP_ALLOCATE:
+      dump_gimple_omp_allocate (buffer, as_a <const gomp_allocate *> (gs), spc,
+				flags);
+      break;
+
     case GIMPLE_CATCH:
       dump_gimple_catch (buffer, as_a <const gcatch *> (gs), spc, flags);
       break;
diff --git a/gcc/gimple.c b/gcc/gimple.c
index 4c02df5aeea..2e70817ec32 100644
--- a/gcc/gimple.c
+++ b/gcc/gimple.c
@@ -1267,6 +1267,16 @@ gimple_build_omp_atomic_store (tree val, enum omp_memory_order mo)
   return p;
 }
 
+gomp_allocate *
+gimple_build_omp_allocate (tree clauses, int kind)
+{
+  gomp_allocate *p
+    = as_a <gomp_allocate *> (gimple_alloc (GIMPLE_OMP_ALLOCATE, 0));
+  gimple_omp_allocate_set_clauses (p, clauses);
+  gimple_omp_allocate_set_kind (p, kind);
+  return p;
+}
+
 /* Build a GIMPLE_TRANSACTION statement.  */
 
 gtransaction *
diff --git a/gcc/gimple.def b/gcc/gimple.def
index 296c73c2d52..079565c3920 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -388,6 +388,12 @@ DEFGSCODE(GIMPLE_OMP_TARGET, "gimple_omp_target", GSS_OMP_PARALLEL_LAYOUT)
    CHILD_FN and DATA_ARG like for GIMPLE_OMP_PARALLEL.  */
 DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT)
 
+/* GIMPLE_OMP_ALLOCATE <CLAUSES> represents
+   #pragma omp allocate
+   CLAUSES is an OMP_CLAUSE chain holding the associated clauses which hold
+   variables to be allocated.  */
+DEFGSCODE(GIMPLE_OMP_ALLOCATE, "gimple_omp_allocate", GSS_OMP_ALLOCATE)
+
 /* GIMPLE_OMP_ORDERED <BODY, CLAUSES> represents #pragma omp ordered.
    BODY is the sequence of statements to execute in the ordered section.
    CLAUSES is an OMP_CLAUSE chain holding the associated clauses.  */
diff --git a/gcc/gimple.h b/gcc/gimple.h
index 7935073195b..97632edf5b9 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -150,6 +150,9 @@ enum gf_mask {
     GF_CALL_BY_DESCRIPTOR	= 1 << 10,
     GF_CALL_NOCF_CHECK		= 1 << 11,
     GF_CALL_FROM_NEW_OR_DELETE	= 1 << 12,
+    GF_OMP_ALLOCATE_KIND_MASK	= (1 << 2) - 1,
+    GF_OMP_ALLOCATE_KIND_ALLOCATE = 1,
+    GF_OMP_ALLOCATE_KIND_FREE = 2,
     GF_OMP_PARALLEL_COMBINED	= 1 << 0,
     GF_OMP_TASK_TASKLOOP	= 1 << 0,
     GF_OMP_TASK_TASKWAIT	= 1 << 1,
@@ -796,6 +799,17 @@ struct GTY((tag("GSS_OMP_ATOMIC_LOAD")))
   tree rhs, lhs;
 };
 
+/* GSS_OMP_ALLOCATE.  */
+
+struct GTY((tag("GSS_OMP_ALLOCATE")))
+  gomp_allocate : public gimple
+{
+  /* [ WORD 1-6 ] : base class */
+
+  /* [ WORD 7 ]  */
+  tree clauses;
+};
+
 /* GIMPLE_OMP_ATOMIC_STORE.
    See note on GIMPLE_OMP_ATOMIC_LOAD.  */
 
@@ -1129,6 +1143,14 @@ is_a_helper <gomp_atomic_store *>::test (gimple *gs)
   return gs->code == GIMPLE_OMP_ATOMIC_STORE;
 }
 
+template <>
+template <>
+inline bool
+is_a_helper <gomp_allocate *>::test (gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_ALLOCATE;
+}
+
 template <>
 template <>
 inline bool
@@ -1371,6 +1393,14 @@ is_a_helper <const gomp_atomic_store *>::test (const gimple *gs)
   return gs->code == GIMPLE_OMP_ATOMIC_STORE;
 }
 
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_allocate *>::test (const gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_ALLOCATE;
+}
+
 template <>
 template <>
 inline bool
@@ -1572,6 +1602,7 @@ gomp_sections *gimple_build_omp_sections (gimple_seq, tree);
 gimple *gimple_build_omp_sections_switch (void);
 gomp_single *gimple_build_omp_single (gimple_seq, tree);
 gomp_target *gimple_build_omp_target (gimple_seq, int, tree);
+gomp_allocate *gimple_build_omp_allocate (tree, int);
 gomp_teams *gimple_build_omp_teams (gimple_seq, tree);
 gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree,
 						enum omp_memory_order);
@@ -2311,7 +2342,7 @@ static inline unsigned
 gimple_omp_subcode (const gimple *s)
 {
   gcc_gimple_checking_assert (gimple_code (s) >= GIMPLE_OMP_ATOMIC_LOAD
-			      && gimple_code (s) <= GIMPLE_OMP_TEAMS);
+			      && gimple_code (s) <= GIMPLE_OMP_ALLOCATE);
   return s->subcode;
 }
 
@@ -6355,6 +6386,30 @@ gimple_omp_sections_set_control (gimple *gs, tree control)
   omp_sections_stmt->control = control;
 }
 
+static inline void
+gimple_omp_allocate_set_clauses (gomp_allocate *gs, tree c)
+{
+  gs->clauses = c;
+}
+
+static inline void
+gimple_omp_allocate_set_kind (gomp_allocate *gs, int kind)
+{
+  gs->subcode = (gs->subcode & ~GF_OMP_ALLOCATE_KIND_MASK)
+		      | (kind & GF_OMP_ALLOCATE_KIND_MASK);
+}
+
+static inline tree
+gimple_omp_allocate_clauses (const gomp_allocate *gs)
+{
+  return gs->clauses;
+}
+
+static inline int
+gimple_omp_allocate_kind (const gomp_allocate *gs)
+{
+  return (gimple_omp_subcode (gs) & GF_OMP_ALLOCATE_KIND_MASK);
+}
 
 /* Set the value being stored in an atomic store.  */
 
@@ -6638,7 +6693,8 @@ gimple_return_set_retval (greturn *gs, tree retval)
     case GIMPLE_OMP_RETURN:			\
     case GIMPLE_OMP_ATOMIC_LOAD:		\
     case GIMPLE_OMP_ATOMIC_STORE:		\
-    case GIMPLE_OMP_CONTINUE
+    case GIMPLE_OMP_CONTINUE:			\
+    case GIMPLE_OMP_ALLOCATE
 
 static inline bool
 is_gimple_omp (const gimple *stmt)
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index d1b27d7f46f..ea080cca72e 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -14103,6 +14103,21 @@ gimplify_omp_workshare (tree *expr_p, gimple_seq *pre_p)
   *expr_p = NULL_TREE;
 }
 
+static void
+gimplify_omp_allocate (tree *expr_p, gimple_seq *pre_p)
+{
+  tree expr = *expr_p;
+  int kind;
+  if (OMP_ALLOCATE_KIND_ALLOCATE (expr))
+    kind = GF_OMP_ALLOCATE_KIND_ALLOCATE;
+  else
+    kind = GF_OMP_ALLOCATE_KIND_FREE;
+  gimple *stmt = gimple_build_omp_allocate (OMP_ALLOCATE_CLAUSES (expr),
+					    kind);
+  gimplify_seq_add_stmt (pre_p, stmt);
+  *expr_p = NULL_TREE;
+}
+
 /* Gimplify the gross structure of OpenACC enter/exit data, update, and OpenMP
    target update constructs.  */
 
@@ -15492,6 +15507,10 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
 	  gimplify_omp_target_update (expr_p, pre_p);
 	  ret = GS_ALL_DONE;
 	  break;
+	case OMP_ALLOCATE:
+	  gimplify_omp_allocate (expr_p, pre_p);
+	  ret = GS_ALL_DONE;
+	  break;
 
 	case OMP_SECTION:
 	case OMP_MASTER:
diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def
index 19e1088b718..9c7526596e8 100644
--- a/gcc/gsstruct.def
+++ b/gcc/gsstruct.def
@@ -50,4 +50,5 @@ DEFGSSTRUCT(GSS_OMP_SINGLE_LAYOUT, gimple_statement_omp_single_layout, false)
 DEFGSSTRUCT(GSS_OMP_CONTINUE, gomp_continue, false)
 DEFGSSTRUCT(GSS_OMP_ATOMIC_LOAD, gomp_atomic_load, false)
 DEFGSSTRUCT(GSS_OMP_ATOMIC_STORE_LAYOUT, gomp_atomic_store, false)
+DEFGSSTRUCT(GSS_OMP_ALLOCATE, gomp_allocate, false)
 DEFGSSTRUCT(GSS_TRANSACTION, gtransaction, false)
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
index 0eb35178e03..6957bc55da0 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" }
 
 module omp_lib_kinds
   use iso_c_binding, only: c_int, c_intptr_t
@@ -71,3 +71,5 @@ 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" } }
-- 
2.25.1