Handle cleanup of omp allocated variables (OpenMP 5.0).

Currently we are only handling omp allocate directive that is associated
with an allocate statement.  This statement results in malloc and free calls.
The malloc calls are easy to get to as they are in the same block as allocate
directive.  But the free calls come in a separate cleanup block.  To help any
later passes finding them, an allocate directive is generated in the
cleanup block with kind=free. The normal allocate directive is given
kind=allocate.

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

gcc/fortran/ChangeLog:

	* gfortran.h (struct access_ref): Declare new members
	omp_allocated and omp_allocated_end.
	* openmp.c (gfc_match_omp_allocate): Set new_st.resolved_sym to
	NULL.
	(prepare_omp_allocated_var_list_for_cleanup): New function.
	(gfc_resolve_omp_allocate): Call it.
	* trans-decl.c (gfc_trans_deferred_vars): Process omp_allocated.
	* trans-openmp.c (gfc_trans_omp_allocate): Set kind for the stmt
	generated for allocate directive.

gcc/ChangeLog:

	* tree-core.h (struct tree_base): Add comments.
	* tree-pretty-print.c (dump_generic_node): Handle allocate directive
	kind.
	* tree.h (OMP_ALLOCATE_KIND_ALLOCATE): New define.
	(OMP_ALLOCATE_KIND_FREE): Likewise.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-6.f90: Test kind of allocate directive.

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index ffd4881022cb43cfed705b6cb6b150de4ac07047..f5d59fbec6ff8b368166c9e53cab887a42434d12 100644 (file)
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,14 @@
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+       Backport of a patch posted at
+       https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588370.html
+
+       * tree-core.h (struct tree_base): Add comments.
+       * tree-pretty-print.c (dump_generic_node): Handle allocate directive
+       kind.
+       * tree.h (OMP_ALLOCATE_KIND_ALLOCATE): New define.
+       (OMP_ALLOCATE_KIND_FREE): Likewise.
+
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
        Backport of a patch posted at

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index df3d17f28f3ee617988f865ad9f7d99acadfd3dc..f1c025799c3e1e51c64c9a6305afe9ff89f59791 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,18 @@
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+       Backport of a patch posted at
+       https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588370.html
+
+       * gfortran.h (struct access_ref): Declare new members
+       omp_allocated and omp_allocated_end.
+       * openmp.c (gfc_match_omp_allocate): Set new_st.resolved_sym to
+       NULL.
+       (prepare_omp_allocated_var_list_for_cleanup): New function.
+       (gfc_resolve_omp_allocate): Call it.
+       * trans-decl.c (gfc_trans_deferred_vars): Process omp_allocated.
+       * trans-openmp.c (gfc_trans_omp_allocate): Set kind for the stmt
+       generated for allocate directive.
+
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
        Backport of a patch posted at

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b4f24c2933850039218a68ca82bc90747d25d43e..2de4507189c25d604b74c2b22fe5565bcf5e1ae5 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1831,6 +1831,7 @@ typedef struct gfc_symbol
   gfc_array_spec *as;
   struct gfc_symbol *result;   /* function result symbol */
   gfc_component *components;   /* Derived type components */
+  gfc_omp_namelist *omp_allocated, *omp_allocated_end;
 
   /* Defined only for Cray pointees; points to their pointer.  */
   struct gfc_symbol *cp_pointer;

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index c364fe2301b1ccec2c9a0a5388ed95e4630ed2f0..7be015f5b3fbd6d15dee61f1c98ecd4bba03ea8c 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -6030,6 +6030,7 @@ gfc_match_omp_allocate (void)
 
   new_st.op = EXEC_OMP_ALLOCATE;
   new_st.ext.omp_clauses = c;
+  new_st.resolved_sym = NULL;
   gfc_free_expr (allocator);
   return MATCH_YES;
 }
@@ -9382,6 +9383,34 @@ gfc_resolve_oacc_routines (gfc_namespace *ns)
     }
 }
 
+static void
+prepare_omp_allocated_var_list_for_cleanup (gfc_omp_namelist *cn, locus loc)
+{
+  gfc_symbol *proc = cn->sym->ns->proc_name;
+  gfc_omp_namelist *p, *n;
+
+  for (n = cn; n; n = n->next)
+    {
+      if (n->sym->attr.allocatable && !n->sym->attr.save
+         && !n->sym->attr.result && !proc->attr.is_main_program)
+       {
+         p = gfc_get_omp_namelist ();
+         p->sym = n->sym;
+         p->expr = gfc_copy_expr (n->expr);
+         p->where = loc;
+         p->next = NULL;
+         if (proc->omp_allocated == NULL)
+           proc->omp_allocated_end = proc->omp_allocated = p;
+         else
+           {
+             proc->omp_allocated_end->next = p;
+             proc->omp_allocated_end = p;
+           }
+
+       }
+    }
+}
+
 static void
 check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al,
                                       gfc_namespace *ns, locus loc)
@@ -9512,6 +9541,7 @@ gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
                                                 code->loc);
        }
     }
+  prepare_omp_allocated_var_list_for_cleanup (cn, code->loc);
 }
 
 

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 096de6e2b044296815a0dfbcd63c14339dfaf9dc..6ef2c9aa34d89457b837a56598d954f7b5a7faaa 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4609,6 +4609,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
          }
     }
 
+  /* Generate a dummy allocate pragma with free kind so that cleanup
+     of those variables which were allocated using the allocate statement
+     associated with an allocate clause happens correctly.  */
+
+  if (proc_sym->omp_allocated)
+    {
+      gfc_clear_new_st ();
+      new_st.op = EXEC_OMP_ALLOCATE;
+      gfc_omp_clauses *c = gfc_get_omp_clauses ();
+      c->lists[OMP_LIST_ALLOCATOR] = proc_sym->omp_allocated;
+      new_st.ext.omp_clauses = c;
+      /* This is just a hacky way to convey to handler that we are
+        dealing with cleanup here.  Saves us from using another field
+        for it.  */
+      new_st.resolved_sym = proc_sym->omp_allocated->sym;
+      gfc_add_init_cleanup (block, NULL,
+                           gfc_trans_omp_directive (&new_st));
+      gfc_free_omp_clauses (c);
+      proc_sym->omp_allocated = NULL;
+    }
 
   /* Initialize the INTENT(OUT) derived type dummy arguments.  This
      should be done here so that the offsets and lbounds of arrays

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 36787c2f088b57e7c43e95ed0bf523717fc01a57..146aa7486116ff14ed35eb4a35f92c1a646c25d8 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -6410,6 +6410,12 @@ gfc_trans_omp_allocate (gfc_code *code)
   OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses,
                                                       code->loc, false,
                                                       true);
+  if (code->next == NULL && code->block == NULL
+      && code->resolved_sym != NULL)
+    OMP_ALLOCATE_KIND_FREE (stmt) = 1;
+  else
+    OMP_ALLOCATE_KIND_ALLOCATE (stmt) = 1;
+
   gfc_add_expr_to_block (&block, stmt);
   gfc_merge_block_scope (&block);
   return gfc_finish_block (&block);

diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index ae8c01822812809ddc4e0de422177a4a52e53d0d..3894b61b3787c977c07deeca5df47f82fd19560c 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/588370.html
+
+       * gfortran.dg/gomp/allocate-6.f90: Test kind of allocate directive.
+
 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
index 2de2b52ee443f10c7ea2fa4c7967c500ef60cde0..0eb35178e03f71e1927f04fddd940040ed3be48d 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -69,4 +69,5 @@ end type
   allocate(pii, parr(5))
 end subroutine
 
-! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } }
+! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } }

diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index e2c641f93912b52d4147e662c58aa8fc5500139a..7cb9c51ccd42a506eab5fdd08bed8cab394b4128 100644 (file)
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -1230,6 +1230,9 @@ struct GTY(()) tree_base {
        EXPR_LOCATION_WRAPPER_P in
           NON_LVALUE_EXPR, VIEW_CONVERT_EXPR
 
+       OMP_ALLOCATE_KIND_ALLOCATE in
+          OMP_ALLOCATE
+
    private_flag:
 
        TREE_PRIVATE in
@@ -1256,6 +1259,9 @@ struct GTY(()) tree_base {
        ENUM_IS_OPAQUE in
           ENUMERAL_TYPE
 
+       OMP_ALLOCATE_KIND_FREE in
+          OMP_ALLOCATE
+
    protected_flag:
 
        TREE_PROTECTED in

diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index dfc7624874b1192f162f051e64f4832cde6eb8b2..fd336d3a216296469ada3cc542175360e94a924f 100644 (file)
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -3538,6 +3538,10 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
 
     case OMP_ALLOCATE:
       pp_string (pp, "#pragma omp allocate ");
+      if (OMP_ALLOCATE_KIND_ALLOCATE (node))
+       pp_string (pp, "(kind=allocate) ");
+      else if (OMP_ALLOCATE_KIND_FREE (node))
+       pp_string (pp, "(kind=free) ");
       dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags);
       break;
 

diff --git a/gcc/tree.h b/gcc/tree.h
index 57fa20193163f7f8250bbac2cc5c7576f6b7538b..414520696cf526f07caa2ba429605729a30354fb 100644 (file)
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1400,6 +1400,10 @@ class auto_suppress_location_wrappers
   TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
 
 #define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0)
+#define OMP_ALLOCATE_KIND_ALLOCATE(NODE) \
+  (OMP_ALLOCATE_CHECK (NODE)->base.public_flag)
+#define OMP_ALLOCATE_KIND_FREE(NODE) \
+  (OMP_ALLOCATE_CHECK (NODE)->base.private_flag)
 
 #define OMP_PARALLEL_BODY(NODE)    TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0)
 #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1)