summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHafiz Abid Qadeer <abidh@codesourcery.com>2022-01-08 18:52:09 +0000
committerHafiz Abid Qadeer <abidh@codesourcery.com>2022-03-10 13:50:34 +0000
commitd245b65b82267ee1f3958730dc1ede240c1f0426 (patch)
treeff8645c4c70e48fc04093097e7020aaeed179dcb
parent7a8f9f47a7c5ec25b2cc472f76505761944666cc (diff)
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.
-rw-r--r--gcc/ChangeLog.omp11
-rw-r--r--gcc/fortran/ChangeLog.omp15
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/openmp.c30
-rw-r--r--gcc/fortran/trans-decl.c20
-rw-r--r--gcc/fortran/trans-openmp.c6
-rw-r--r--gcc/testsuite/ChangeLog.omp7
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/allocate-6.f903
-rw-r--r--gcc/tree-core.h6
-rw-r--r--gcc/tree-pretty-print.c4
-rw-r--r--gcc/tree.h4
11 files changed, 106 insertions, 1 deletions
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index ffd4881022c..f5d59fbec6f 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/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
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index df3d17f28f3..f1c025799c3 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,6 +1,21 @@
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
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
* trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b4f24c29338..2de4507189c 100644
--- 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 c364fe2301b..7be015f5b3f 100644
--- 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;
}
@@ -9383,6 +9384,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 096de6e2b04..6ef2c9aa34d 100644
--- 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 36787c2f088..146aa748611 100644
--- 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 ae8c0182281..3894b61b378 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,6 +1,13 @@
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
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
* gfortran.dg/gomp/allocate-6.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
index 2de2b52ee44..0eb35178e03 100644
--- 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 e2c641f9391..7cb9c51ccd4 100644
--- 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 dfc7624874b..fd336d3a216 100644
--- 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 57fa2019316..414520696cf 100644
--- 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)