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.cc (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.cc (gfc_trans_deferred_vars): Process omp_allocated.
	* trans-openmp.cc (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.cc (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 de44896c91d4a276615bd6c38590b8643d720612..1de2cecf23753375bdbac646aa81521b74bababb 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.cc (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 531d28335b4a81e7a739939ac7dab1e1d3f30902..9e2b67850dff95dc18c7fd74854daa9503d552ad 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.cc (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.cc (gfc_trans_deferred_vars): Process omp_allocated.
+       * trans-openmp.ccc (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 9f1e78576ce573b6dcc69dc830a419a556d87932..62c0640c3a17a1c44a41845c694a22978c14d062 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1837,6 +1837,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.cc b/gcc/fortran/openmp.cc
index fb59d9b6b46362ba8da03385c9e1a556b07d6d54..42423585395f09840faf178b4724befeb7a3673e 100644 (file)
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6042,6 +6042,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;
 }
@@ -9409,6 +9410,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)
@@ -9539,6 +9568,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.cc b/gcc/fortran/trans-decl.cc
index 71ce0091283e816589a7c2156b0f1fbbd104bd99..607f0cb441b5b3c468f4d56122dee074396b1c5b 100644 (file)
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4591,6 +4591,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.cc b/gcc/fortran/trans-openmp.cc
index d28720b3155c284651d4fb2fb14f56ac7e81b0e3..ef9888354a3311e1aec0d0657953b321ddf38603 100644 (file)
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -6432,6 +6432,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 5d7555e917b6a86760db4fe702eff462080ec94b..0893957b6cdb1dd39f46324876abc59ebf7e4460 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 0aef3073cb079ee55dd5f027b0d3922e1484bcda..8bf4e0cf7fd04aabb0606cdab1811aa2bd02f2e3 100644 (file)
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -1259,6 +1259,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
@@ -1285,6 +1288,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.cc b/gcc/tree-pretty-print.cc
index c00428e34c75c2af12c342467ddc2c9778665f36..030fcfe9550324015f54c7ba608a26a166c7ed85 100644 (file)
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -3558,6 +3558,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 8cc13b61a00ca149a9912d72bc9788939f6bb8db..d3df44ec9dc2571aca82eb91d2823ef70ab0460d 100644 (file)
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1417,6 +1417,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)