* [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).
2022-01-13 14:53 [PATCH 0/5] [gfortran] Support for allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
@ 2022-01-13 14:53 ` Hafiz Abid Qadeer
2022-10-11 12:13 ` Jakub Jelinek
` (2 more replies)
2022-01-13 14:53 ` [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
` (3 subsequent siblings)
4 siblings, 3 replies; 15+ messages in thread
From: Hafiz Abid Qadeer @ 2022-01-13 14:53 UTC (permalink / raw)
To: gcc-patches, fortran; +Cc: tobias, jakub
Currently we only make use of this directive when it is associated
with an allocate statement.
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_ALLOCATE.
(show_code_node): Likewise.
* gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE.
(OMP_LIST_ALLOCATOR): New enum value.
(enum gfc_exec_op): Add EXEC_OMP_ALLOCATE.
* match.h (gfc_match_omp_allocate): New function.
* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR.
(OMP_ALLOCATE_CLAUSES): New define.
(gfc_match_omp_allocate): New function.
(resolve_omp_clauses): Add ALLOCATOR in clause_names.
(omp_code_to_statement): Handle EXEC_OMP_ALLOCATE.
(EMPTY_VAR_LIST): New define.
(check_allocate_directive_restrictions): New function.
(gfc_resolve_omp_allocate): Likewise.
(gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE.
* parse.c (decode_omp_directive): Handle ST_OMP_ALLOCATE.
(next_statement): Likewise.
(gfc_ascii_statement): Likewise.
* resolve.c (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE.
* st.c (gfc_free_statement): Likewise.
* trans.c (trans_code): Likewise
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-4.f90: New test.
* gfortran.dg/gomp/allocate-5.f90: New test.
---
gcc/fortran/dump-parse-tree.c | 3 +
gcc/fortran/gfortran.h | 4 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 199 +++++++++++++++++-
gcc/fortran/parse.c | 10 +-
gcc/fortran/resolve.c | 1 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 112 ++++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 73 +++++++
10 files changed, 400 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 7459f4b89a9..38fef42150a 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1993,6 +1993,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
+ case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break;
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OMP_CANCEL: name = "CANCEL"; break;
@@ -2194,6 +2195,7 @@ show_omp_node (int level, gfc_code *c)
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
|| c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
+ || c->op == EXEC_OMP_ALLOCATE
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3314,6 +3316,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3b791a4f6be..79a43a2fdf0 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -259,7 +259,7 @@ enum gfc_statement
ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL,
ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
- ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
+ ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, ST_OMP_ALLOCATE,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1392,6 +1392,7 @@ enum
OMP_LIST_USE_DEVICE_PTR,
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NONTEMPORAL,
+ OMP_LIST_ALLOCATOR,
OMP_LIST_NUM
};
@@ -2893,6 +2894,7 @@ enum gfc_exec_op
EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
+ EXEC_OMP_ALLOCATE,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 65ee3b6cb41..9f0449eda0e 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -149,6 +149,7 @@ match gfc_match_oacc_routine (void);
/* OpenMP directive matchers. */
match gfc_match_omp_eos_error (void);
+match gfc_match_omp_allocate (void);
match gfc_match_omp_atomic (void);
match gfc_match_omp_barrier (void);
match gfc_match_omp_cancel (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 86c412a4334..ee7c39980bb 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -921,6 +921,7 @@ enum omp_mask1
OMP_CLAUSE_FAIL, /* OpenMP 5.1. */
OMP_CLAUSE_WEAK, /* OpenMP 5.1. */
OMP_CLAUSE_NOWAIT,
+ OMP_CLAUSE_ALLOCATOR,
/* This must come last. */
OMP_MASK1_LAST
};
@@ -3568,6 +3569,7 @@ cleanup:
}
+#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR))
#define OMP_PARALLEL_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
@@ -5762,6 +5764,64 @@ gfc_match_omp_ordered_depend (void)
return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
}
+/* omp allocate (list) [clause-list]
+ - clause-list: allocator
+*/
+
+match
+gfc_match_omp_allocate (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_expr *allocator = NULL;
+ match m;
+
+ m = gfc_match (" (");
+ if (m == MATCH_YES)
+ {
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR],
+ true, NULL);
+
+ if (m != MATCH_YES)
+ {
+ /* If the list was empty, we must find closing ')'. */
+ m = gfc_match (")");
+ if (m != MATCH_YES)
+ return m;
+ }
+ }
+
+ if (gfc_match (" allocator ( ") == MATCH_YES)
+ {
+ m = gfc_match_expr (&allocator);
+ if (m != MATCH_YES)
+ {
+ gfc_error ("Expected allocator at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match (" ) ") != MATCH_YES)
+ {
+ gfc_error ("Expected ')' at %C");
+ gfc_free_expr (allocator);
+ return MATCH_ERROR;
+ }
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_expr (allocator);
+ gfc_error ("Unexpected junk after $OMP allocate at %C");
+ return MATCH_ERROR;
+ }
+ gfc_omp_namelist *n;
+ for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
+ n->expr = gfc_copy_expr (allocator);
+
+ new_st.op = EXEC_OMP_ALLOCATE;
+ new_st.ext.omp_clauses = c;
+ gfc_free_expr (allocator);
+ return MATCH_YES;
+}
+
/* omp atomic [clause-list]
- atomic-clause: read | write | update
@@ -6243,7 +6303,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"IN_REDUCTION", "TASK_REDUCTION",
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
- "NONTEMPORAL" };
+ "NONTEMPORAL", "ALLOCATOR" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@@ -8507,6 +8567,8 @@ omp_code_to_statement (gfc_code *code)
{
switch (code->op)
{
+ case EXEC_OMP_ALLOCATE:
+ return ST_OMP_ALLOCATE;
case EXEC_OMP_PARALLEL:
return ST_OMP_PARALLEL;
case EXEC_OMP_PARALLEL_MASKED:
@@ -8987,6 +9049,138 @@ gfc_resolve_oacc_routines (gfc_namespace *ns)
}
}
+static void
+check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al,
+ gfc_namespace *ns, locus loc)
+{
+ if (sym->attr.save != SAVE_NONE || sym->attr.in_common == 1
+ || sym->module != NULL)
+ {
+ int tmp;
+ /* Assumption here is that we can extract an integer then
+ it is a predefined thing. */
+ if (!omp_al || gfc_extract_int (omp_al, &tmp))
+ gfc_error ("%qs should use predefined allocator at %L", sym->name,
+ &loc);
+ }
+ if (ns != sym->ns)
+ gfc_error ("%qs is not in the same scope as %<allocate%>"
+ " directive at %L", sym->name, &loc);
+}
+
+#define EMPTY_VAR_LIST(node) \
+ (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL)
+
+static void
+gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
+{
+ gfc_alloc *al;
+ gfc_omp_namelist *n = NULL;
+ gfc_omp_namelist *cn = NULL;
+ gfc_omp_namelist *p, *tail;
+ gfc_code *cur;
+ hash_set<gfc_symbol*> vars;
+
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
+ gcc_assert (clauses);
+ cn = clauses->lists[OMP_LIST_ALLOCATOR];
+ gfc_expr *omp_al = cn ? cn->expr : NULL;
+
+ if (omp_al && (omp_al->ts.type != BT_INTEGER
+ || omp_al->ts.kind != gfc_c_intptr_kind))
+ gfc_error ("Expected integer expression of the "
+ "%<omp_allocator_handle_kind%> kind at %L", &omp_al->where);
+
+ /* Check that variables in this allocate directive are not duplicated
+ in this directive or others coming directly after it. */
+ for (cur = code; cur != NULL && cur->op == EXEC_OMP_ALLOCATE;
+ cur = cur->next)
+ {
+ gfc_omp_clauses *c = cur->ext.omp_clauses;
+ gcc_assert (c);
+ for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
+ {
+ if (vars.contains (n->sym))
+ gfc_error ("%qs is used in multiple %<allocate%> "
+ "directives at %L", n->sym->name, &cur->loc);
+ /* This helps us avoid duplicate error messages. */
+ if (cur == code)
+ vars.add (n->sym);
+ }
+ }
+
+ if (cur == NULL || cur->op != EXEC_ALLOCATE)
+ {
+ /* There is no allocate statement right after allocate directive.
+ We don't support this case at the moment. */
+ for (n = cn; n != NULL; n = n->next)
+ {
+ gfc_symbol *sym = n->sym;
+ if (sym->attr.allocatable == 1)
+ gfc_error ("%qs with ALLOCATABLE attribute is not allowed in "
+ "%<allocate%> directive at %L as this directive is not"
+ " associated with an %<allocate%> statement.",
+ sym->name, &code->loc);
+ }
+ sorry_at (code->loc.lb->location, "%<allocate%> directive that is "
+ "not associated with an %<allocate%> statement is not "
+ "supported.");
+ return;
+ }
+
+ /* If there is another allocate directive right after this one, check
+ that none of them is empty. Doing it this way, we can check this
+ thing even when multiple directives are together and generate
+ error at right location. */
+ if (code->next && code->next->op == EXEC_OMP_ALLOCATE
+ && (EMPTY_VAR_LIST (code) || EMPTY_VAR_LIST (code->next)))
+ gfc_error ("Empty variable list is not allowed at %L when multiple "
+ "%<allocate%> directives are associated with an "
+ "%<allocate%> statement.",
+ EMPTY_VAR_LIST (code) ? &code->loc : &code->next->loc);
+
+ if (EMPTY_VAR_LIST (code))
+ {
+ /* Empty namelist means allocate directive applies to all
+ variables in allocate statement. 'cur' points to associated
+ allocate statement. */
+ for (al = cur->ext.alloc.list; al != NULL; al = al->next)
+ if (al->expr && al->expr->symtree && al->expr->symtree->n.sym)
+ {
+ check_allocate_directive_restrictions (al->expr->symtree->n.sym,
+ omp_al, ns, code->loc);
+ p = gfc_get_omp_namelist ();
+ p->sym = al->expr->symtree->n.sym;
+ p->expr = omp_al;
+ p->where = code->loc;
+ if (cn == NULL)
+ cn = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ }
+ clauses->lists[OMP_LIST_ALLOCATOR]= cn;
+ }
+ else
+ {
+ for (n = cn; n != NULL; n = n->next)
+ {
+ for (al = cur->ext.alloc.list; al != NULL; al = al->next)
+ if (al->expr && al->expr->symtree && al->expr->symtree->n.sym
+ && al->expr->symtree->n.sym == n->sym)
+ break;
+ if (al == NULL)
+ gfc_error ("%qs in %<allocate%> directive at %L is not present "
+ "in associated %<allocate%> statement.",
+ n->sym->name, &code->loc);
+ check_allocate_directive_restrictions (n->sym, omp_al, ns,
+ code->loc);
+ }
+ }
+}
+
void
gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
@@ -9128,6 +9322,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
code->ext.omp_clauses->if_present = false;
resolve_omp_clauses (code, code->ext.omp_clauses, ns);
break;
+ case EXEC_OMP_ALLOCATE:
+ gfc_resolve_omp_allocate (code, ns);
+ break;
default:
break;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index c04ad774f25..fda36433129 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -886,6 +886,7 @@ decode_omp_directive (void)
{
case 'a':
matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
+ matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
break;
case 'b':
matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
@@ -1672,9 +1673,9 @@ next_statement (void)
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
- case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
- case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
- case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
+ case ST_OMP_ALLOCATE: case ST_ERROR_STOP: case ST_OMP_SCAN: \
+ case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: \
+ case ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
case ST_END_TEAM: case ST_SYNC_TEAM: \
case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
@@ -2351,6 +2352,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OACC_END_ATOMIC:
p = "!$ACC END ATOMIC";
break;
+ case ST_OMP_ALLOCATE:
+ p = "!$OMP ALLOCATE";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 43eeefee07f..991cd4fe874 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12306,6 +12306,7 @@ start:
gfc_resolve_oacc_directive (code, ns);
break;
+ case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CANCEL:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 73f30c2137f..7b282e96c3d 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
+ case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 26f0815b5ea..a2248c83623 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2140,6 +2140,7 @@ trans_code (gfc_code * code, tree cond)
res = gfc_trans_dt_end (code);
break;
+ case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CANCEL:
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
new file mode 100644
index 00000000000..3f512d66495
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
@@ -0,0 +1,112 @@
+! { dg-do compile }
+
+module test
+ integer, allocatable :: mvar1
+ integer, allocatable :: mvar2
+ integer, allocatable :: mvar3
+end module
+
+subroutine foo(x, y)
+ use omp_lib
+ implicit none
+ integer :: x
+ integer :: y
+
+ integer, allocatable :: var1(:)
+ integer, allocatable :: var2(:)
+ integer, allocatable :: var3(:)
+ integer, allocatable :: var4(:)
+ integer, allocatable :: var5(:)
+ integer, allocatable :: var6(:)
+ integer, allocatable :: var7(:)
+ integer, allocatable :: var8(:)
+ integer, allocatable :: var9(:)
+
+ !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+ allocate (var1(x))
+
+ !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ allocate (var3(x))
+
+ !$omp allocate (x) ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." }
+ x = 2
+
+ !$omp allocate (var4) ! { dg-error "'var4' with ALLOCATABLE attribute is not allowed in 'allocate' directive at .1. as this directive is not associated with an 'allocate' statement." }
+ ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." "" { target *-*-* } .-1 }
+ y = 2
+
+ !$omp allocate (var5)
+ !$omp allocate ! { dg-error "Empty variable list is not allowed at .1. when multiple 'allocate' directives are associated with an 'allocate' statement." }
+ allocate (var5(x))
+
+ !$omp allocate (var6)
+ !$omp allocate (var7) ! { dg-error "'var7' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ !$omp allocate (var8) ! { dg-error "'var8' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ allocate (var6(x))
+
+ !$omp allocate (var9)
+ !$omp allocate (var9) ! { dg-error "'var9' is used in multiple 'allocate' directives at .1." }
+ allocate (var9(x))
+
+end subroutine
+
+function outer(a)
+ IMPLICIT NONE
+
+ integer :: outer, a
+ integer, allocatable :: var1
+
+ outer = inner(a) + 5
+ return
+
+ contains
+
+ integer function inner(x)
+ integer :: x
+ integer, allocatable :: var2
+
+ !$omp allocate (var1, var2) ! { dg-error "'var1' is not in the same scope as 'allocate' directive at .1." }
+ allocate (var1, var2)
+
+ inner = x + 10
+ return
+ end function inner
+
+end function outer
+
+subroutine bar(s)
+ use omp_lib
+ use test
+ integer :: s
+ integer, save, allocatable :: svar1
+ integer, save, allocatable :: svar2
+ integer, save, allocatable :: svar3
+
+ 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
+
+ !$omp allocate (mvar1) allocator(a) ! { dg-error "'mvar1' should use predefined allocator at .1." }
+ allocate (mvar1)
+
+ !$omp allocate (mvar2) ! { dg-error "'mvar2' should use predefined allocator at .1." }
+ allocate (mvar2)
+
+ !$omp allocate (mvar3) allocator(omp_low_lat_mem_alloc)
+ allocate (mvar3)
+
+ !$omp allocate (svar1) allocator(a) ! { dg-error "'svar1' should use predefined allocator at .1." }
+ allocate (svar1)
+
+ !$omp allocate (svar2) ! { dg-error "'svar2' should use predefined allocator at .1." }
+ allocate (svar2)
+
+ !$omp allocate (svar3) allocator(omp_low_lat_mem_alloc)
+ allocate (svar3)
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
new file mode 100644
index 00000000000..761b6dede28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
@@ -0,0 +1,73 @@
+! { dg-do compile }
+
+module omp_lib_kinds
+ use iso_c_binding, only: c_int, c_intptr_t
+ implicit none
+ private :: c_int, c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module
+
+subroutine foo(x, y)
+ use omp_lib_kinds
+ implicit none
+ integer :: x
+ integer :: y
+
+ integer, allocatable :: var1(:)
+ integer, allocatable :: var2(:)
+ integer, allocatable :: var3(:)
+ integer, allocatable :: var4(:,:)
+ integer, allocatable :: var5(:)
+ integer, allocatable :: var6(:)
+ integer, allocatable :: var7(:)
+ integer, allocatable :: var8(:)
+ integer, allocatable :: var9(:)
+ integer, allocatable :: var10(:)
+ integer, allocatable :: var11(:)
+ integer, allocatable :: var12(:)
+
+ !$omp allocate (var1) allocator(omp_default_mem_alloc)
+ allocate (var1(x))
+
+ !$omp allocate (var2)
+ allocate (var2(x))
+
+ !$omp allocate (var3, var4) allocator(omp_large_cap_mem_alloc)
+ allocate (var3(x),var4(x,y))
+
+ !$omp allocate()
+ allocate (var5(x))
+
+ !$omp allocate
+ allocate (var6(x))
+
+ !$omp allocate () allocator(omp_default_mem_alloc)
+ allocate (var7(x))
+
+ !$omp allocate allocator(omp_default_mem_alloc)
+ allocate (var8(x))
+
+ !$omp allocate (var9) allocator(omp_default_mem_alloc)
+ !$omp allocate (var10) allocator(omp_large_cap_mem_alloc)
+ allocate (var9(x), var10(x))
+
+end subroutine
--
2.25.1
^ permalink raw reply [flat|nested] 15+ messages in thread* Re: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).
2022-01-13 14:53 ` [PATCH 1/5] [gfortran] Add parsing support " Hafiz Abid Qadeer
@ 2022-10-11 12:13 ` Jakub Jelinek
2023-02-01 11:59 ` [og12] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).) Thomas Schwinge
2023-02-09 11:35 ` [og12] 'gfortran.dg/gomp/allocate-4.f90' -> 'libgomp.fortran/allocate-5.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0)) Thomas Schwinge
2 siblings, 0 replies; 15+ messages in thread
From: Jakub Jelinek @ 2022-10-11 12:13 UTC (permalink / raw)
To: Hafiz Abid Qadeer; +Cc: gcc-patches, fortran, tobias
On Thu, Jan 13, 2022 at 02:53:16PM +0000, Hafiz Abid Qadeer wrote:
> Currently we only make use of this directive when it is associated
> with an allocate statement.
Sorry for the delay.
I'll start with a comment that allocate directive in 5.0/5.1
for Fortran is a complete mess that has been fixed only in 5.2
by splitting the directive into the allocators construct and
allocate directive.
The problem with 5.0/5.1 is that it is just ambiguous whether
!$omp allocate (list) optional-clauses
is associated with an allocate statement or not.
When it is not associated with allocate statement, it is a declarative
directive that should appear only in the specification part, when it is
associated with a allocate stmt, it should appear only in the executable
part. And a mess starts when it is on the boundary between the two.
Now, how exactly to differentiate between the 2 I'm afraid depends
on the exact OpenMP version.
1) if we are p->state == ORDER_EXEC already, it must be associated
with allocate-stmt (and we should error whenever it violates restrictions
for those)
2) if (list) is missing, it must be associated with allocate-stmt
3) for 5.0 only, if allocator clause isn't specified, it must be
not associated with allocate-stmt, but in 5.1 the clauses are optional
also for one associated with it; if align clause is specified, it must be
5.1
4) all the allocate directives after one that must be associated with
allocate-stmt must be also associated with allocate-stmt
5) if variables in list are allocatable, it must be associated with
allocate-stmt, if they aren't allocatable, it must not be associated
with allocate-stmt
In your patch, you put ST_OMP_ALLOCATE into case_executable define,
I'm afraid due to the above we need to handle ST_OMP_ALLOCATE manually
whenever case_executable/case_omp_decl appear in parse.cc and be prepared
that it could be either declarative directive or executable construct
and resolve based on the 1-5 above into which category it belongs
(either during parsing or during resolving). And certainly have
testsuite coverage for cases like:
integer :: i, j
integer, allocatable :: k(:), l(:)
!$omp allocate (i) allocator (alloc1)
!$omp allocate (j) allocator (alloc2)
!$omp allocate (k) allocator (alloc3)
!$omp allocate (l) allocator (alloc4)
allocate (k(14), l(23))
where I think the first 2 are declarative directives and the last
2 bind to allocate-stmt (etc., cover all the cases mentioned above).
On the other side, 5.1 has:
"An allocate directive that is associated with an allocate-stmt and specifies a list must be
preceded by an executable statement or OpenMP construct."
restriction, so if we implement that, the ambiguity decreases.
We wouldn't need to worry about 3) and 5), would decide on 1) and 2) and 4)
only.
> gcc/fortran/ChangeLog:
>
> * dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_ALLOCATE.
> (show_code_node): Likewise.
> * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE.
> (OMP_LIST_ALLOCATOR): New enum value.
> (enum gfc_exec_op): Add EXEC_OMP_ALLOCATE.
> * match.h (gfc_match_omp_allocate): New function.
> * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR.
> (OMP_ALLOCATE_CLAUSES): New define.
> (gfc_match_omp_allocate): New function.
> (resolve_omp_clauses): Add ALLOCATOR in clause_names.
> (omp_code_to_statement): Handle EXEC_OMP_ALLOCATE.
> (EMPTY_VAR_LIST): New define.
> (check_allocate_directive_restrictions): New function.
> (gfc_resolve_omp_allocate): Likewise.
> (gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE.
> * parse.c (decode_omp_directive): Handle ST_OMP_ALLOCATE.
> (next_statement): Likewise.
You didn't change next_statement, but case_executable macro.
But see above.
> (gfc_ascii_statement): Likewise.
> * resolve.c (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE.
> * st.c (gfc_free_statement): Likewise.
> * trans.c (trans_code): Likewise
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/gomp/allocate-4.f90: New test.
> * gfortran.dg/gomp/allocate-5.f90: New test.
> ---
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -921,6 +921,7 @@ enum omp_mask1
> OMP_CLAUSE_FAIL, /* OpenMP 5.1. */
> OMP_CLAUSE_WEAK, /* OpenMP 5.1. */
> OMP_CLAUSE_NOWAIT,
> + OMP_CLAUSE_ALLOCATOR,
I don't see how can you add OMP_CLAUSE_ALLOCATOR to enum omp_mask1.
OMP_MASK1_LAST is already 64, so I think the
gcc_checking_assert (OMP_MASK1_LAST <= 64 && OMP_MASK2_LAST <= 64);
assertion would fail.
OMP_MASK2_LAST is on the other side just 30, and allocate directive
takes just allocator or in 5.1 align clauses, so both should
go to the enum omp_mask2 block. And for newly added clauses,
we add the /* OpenMP 5.0. */ etc. comments when the clause
appeared first (5.0 for allocator, 5.1 for align).
> /* This must come last. */
> OMP_MASK1_LAST
> };
> @@ -3568,6 +3569,7 @@ cleanup:
> }
>
>
> +#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR))
You define the above.
> #define OMP_PARALLEL_CLAUSES \
> (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
> | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
> @@ -5762,6 +5764,64 @@ gfc_match_omp_ordered_depend (void)
> return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
> }
>
> +/* omp allocate (list) [clause-list]
> + - clause-list: allocator
> +*/
> +
> +match
> +gfc_match_omp_allocate (void)
> +{
> + gfc_omp_clauses *c = gfc_get_omp_clauses ();
> + gfc_expr *allocator = NULL;
> + match m;
> +
> + m = gfc_match (" (");
> + if (m == MATCH_YES)
> + {
> + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR],
> + true, NULL);
> +
> + if (m != MATCH_YES)
> + {
> + /* If the list was empty, we must find closing ')'. */
Empty list should be invalid if ( is seen, no?
> + m = gfc_match (")");
> + if (m != MATCH_YES)
> + return m;
> + }
> + }
> +
> + if (gfc_match (" allocator ( ") == MATCH_YES)
> + {
> + m = gfc_match_expr (&allocator);
> + if (m != MATCH_YES)
> + {
> + gfc_error ("Expected allocator at %C");
> + return MATCH_ERROR;
> + }
> + if (gfc_match (" ) ") != MATCH_YES)
> + {
> + gfc_error ("Expected ')' at %C");
> + gfc_free_expr (allocator);
> + return MATCH_ERROR;
> + }
> + }
But then parse the allocator clause by hand, so
OMP_ALLOCATE_CLAUSES is never used. I think it would be better
to go through the normal clause parsing because we'll need to handle
align clause too soon and while there can be at most one allocator
clause and at most one align clause, they can appear in either order,
and there can or doesn't have to be a comma in between them.
> + if (!omp_al || gfc_extract_int (omp_al, &tmp))
> + gfc_error ("%qs should use predefined allocator at %L", sym->name,
> + &loc);
> + }
> + if (ns != sym->ns)
> + gfc_error ("%qs is not in the same scope as %<allocate%>"
> + " directive at %L", sym->name, &loc);
> +}
> +
> +#define EMPTY_VAR_LIST(node) \
> + (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL)
> +
> +static void
> +gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
> +{
> + gfc_alloc *al;
> + gfc_omp_namelist *n = NULL;
> + gfc_omp_namelist *cn = NULL;
> + gfc_omp_namelist *p, *tail;
> + gfc_code *cur;
> + hash_set<gfc_symbol*> vars;
> +
> + gfc_omp_clauses *clauses = code->ext.omp_clauses;
> + gcc_assert (clauses);
> + cn = clauses->lists[OMP_LIST_ALLOCATOR];
> + gfc_expr *omp_al = cn ? cn->expr : NULL;
> +
> + if (omp_al && (omp_al->ts.type != BT_INTEGER
> + || omp_al->ts.kind != gfc_c_intptr_kind))
The formatting is weird, || should be below omp_al->
> + gfc_error ("Expected integer expression of the "
> + "%<omp_allocator_handle_kind%> kind at %L", &omp_al->where);
Jakub
^ permalink raw reply [flat|nested] 15+ messages in thread* [og12] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).)
2022-01-13 14:53 ` [PATCH 1/5] [gfortran] Add parsing support " Hafiz Abid Qadeer
2022-10-11 12:13 ` Jakub Jelinek
@ 2023-02-01 11:59 ` Thomas Schwinge
2023-02-01 12:12 ` Tobias Burnus
2023-02-09 11:35 ` [og12] 'gfortran.dg/gomp/allocate-4.f90' -> 'libgomp.fortran/allocate-5.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0)) Thomas Schwinge
2 siblings, 1 reply; 15+ messages in thread
From: Thomas Schwinge @ 2023-02-01 11:59 UTC (permalink / raw)
To: Hafiz Abid Qadeer, gcc-patches, fortran; +Cc: Jakub Jelinek, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 27265 bytes --]
Hi!
On 2022-01-13T14:53:16+0000, Hafiz Abid Qadeer <abidh@codesourcery.com> wrote:
> Currently we only make use of this directive when it is associated
> with an allocate statement.
These changes (or a variant thereof; haven't checked)
are present on devel/omp/gcc-12 branch as
commit 491478d12b83e102f72858e8a871a25c951df293
"Add parsing support for allocate directive (OpenMP 5.0)".
I've noticed that while this new test case
'gfortran.dg/gomp/allocate-4.f90':
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> @@ -0,0 +1,112 @@
> +! { dg-do compile }
> +
> +module test
> + integer, allocatable :: mvar1
> + integer, allocatable :: mvar2
> + integer, allocatable :: mvar3
> +end module
> +
> +subroutine foo(x, y)
> + use omp_lib
> + implicit none
> + integer :: x
> + integer :: y
> +
> + integer, allocatable :: var1(:)
> + integer, allocatable :: var2(:)
> + integer, allocatable :: var3(:)
> + integer, allocatable :: var4(:)
> + integer, allocatable :: var5(:)
> + integer, allocatable :: var6(:)
> + integer, allocatable :: var7(:)
> + integer, allocatable :: var8(:)
> + integer, allocatable :: var9(:)
> +
> + !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
> + allocate (var1(x))
> +
> + !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
> + allocate (var3(x))
> +[...]
... is all-PASS for x86_64-pc-linux-gnu (default) '-m64' testing, is does
have one FAIL for '-m32' testing: 'test for errors, line 25'. Here's the
'diff':
@@ -1,8 +1,3 @@
-source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:25:34:
-
- 25 | !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
- | 1
-Error: Expected integer expression of the ‘omp_allocator_handle_kind’ kind at (1)
source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:28:130:
28 | !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
OK to push to devel/omp/gcc-12 branch the attached
"Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90'",
or is a different solution called for?
Grüße
Thomas
> gcc/fortran/ChangeLog:
>
> * dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_ALLOCATE.
> (show_code_node): Likewise.
> * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE.
> (OMP_LIST_ALLOCATOR): New enum value.
> (enum gfc_exec_op): Add EXEC_OMP_ALLOCATE.
> * match.h (gfc_match_omp_allocate): New function.
> * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR.
> (OMP_ALLOCATE_CLAUSES): New define.
> (gfc_match_omp_allocate): New function.
> (resolve_omp_clauses): Add ALLOCATOR in clause_names.
> (omp_code_to_statement): Handle EXEC_OMP_ALLOCATE.
> (EMPTY_VAR_LIST): New define.
> (check_allocate_directive_restrictions): New function.
> (gfc_resolve_omp_allocate): Likewise.
> (gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE.
> * parse.c (decode_omp_directive): Handle ST_OMP_ALLOCATE.
> (next_statement): Likewise.
> (gfc_ascii_statement): Likewise.
> * resolve.c (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE.
> * st.c (gfc_free_statement): Likewise.
> * trans.c (trans_code): Likewise
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/gomp/allocate-4.f90: New test.
> * gfortran.dg/gomp/allocate-5.f90: New test.
> ---
> gcc/fortran/dump-parse-tree.c | 3 +
> gcc/fortran/gfortran.h | 4 +-
> gcc/fortran/match.h | 1 +
> gcc/fortran/openmp.c | 199 +++++++++++++++++-
> gcc/fortran/parse.c | 10 +-
> gcc/fortran/resolve.c | 1 +
> gcc/fortran/st.c | 1 +
> gcc/fortran/trans.c | 1 +
> gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 112 ++++++++++
> gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 73 +++++++
> 10 files changed, 400 insertions(+), 5 deletions(-)
> create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
>
> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
> index 7459f4b89a9..38fef42150a 100644
> --- a/gcc/fortran/dump-parse-tree.c
> +++ b/gcc/fortran/dump-parse-tree.c
> @@ -1993,6 +1993,7 @@ show_omp_node (int level, gfc_code *c)
> case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
> case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
> case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
> + case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break;
> case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
> case EXEC_OMP_BARRIER: name = "BARRIER"; break;
> case EXEC_OMP_CANCEL: name = "CANCEL"; break;
> @@ -2194,6 +2195,7 @@ show_omp_node (int level, gfc_code *c)
> || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
> || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
> || c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
> + || c->op == EXEC_OMP_ALLOCATE
> || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
> return;
> if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
> @@ -3314,6 +3316,7 @@ show_code_node (int level, gfc_code *c)
> case EXEC_OACC_CACHE:
> case EXEC_OACC_ENTER_DATA:
> case EXEC_OACC_EXIT_DATA:
> + case EXEC_OMP_ALLOCATE:
> case EXEC_OMP_ATOMIC:
> case EXEC_OMP_CANCEL:
> case EXEC_OMP_CANCELLATION_POINT:
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index 3b791a4f6be..79a43a2fdf0 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -259,7 +259,7 @@ enum gfc_statement
> ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
> ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL,
> ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
> - ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
> + ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, ST_OMP_ALLOCATE,
> ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
> ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
> ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
> @@ -1392,6 +1392,7 @@ enum
> OMP_LIST_USE_DEVICE_PTR,
> OMP_LIST_USE_DEVICE_ADDR,
> OMP_LIST_NONTEMPORAL,
> + OMP_LIST_ALLOCATOR,
> OMP_LIST_NUM
> };
>
> @@ -2893,6 +2894,7 @@ enum gfc_exec_op
> EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
> EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
> EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
> + EXEC_OMP_ALLOCATE,
> EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
> EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
> EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
> diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
> index 65ee3b6cb41..9f0449eda0e 100644
> --- a/gcc/fortran/match.h
> +++ b/gcc/fortran/match.h
> @@ -149,6 +149,7 @@ match gfc_match_oacc_routine (void);
>
> /* OpenMP directive matchers. */
> match gfc_match_omp_eos_error (void);
> +match gfc_match_omp_allocate (void);
> match gfc_match_omp_atomic (void);
> match gfc_match_omp_barrier (void);
> match gfc_match_omp_cancel (void);
> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
> index 86c412a4334..ee7c39980bb 100644
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -921,6 +921,7 @@ enum omp_mask1
> OMP_CLAUSE_FAIL, /* OpenMP 5.1. */
> OMP_CLAUSE_WEAK, /* OpenMP 5.1. */
> OMP_CLAUSE_NOWAIT,
> + OMP_CLAUSE_ALLOCATOR,
> /* This must come last. */
> OMP_MASK1_LAST
> };
> @@ -3568,6 +3569,7 @@ cleanup:
> }
>
>
> +#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR))
> #define OMP_PARALLEL_CLAUSES \
> (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
> | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
> @@ -5762,6 +5764,64 @@ gfc_match_omp_ordered_depend (void)
> return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
> }
>
> +/* omp allocate (list) [clause-list]
> + - clause-list: allocator
> +*/
> +
> +match
> +gfc_match_omp_allocate (void)
> +{
> + gfc_omp_clauses *c = gfc_get_omp_clauses ();
> + gfc_expr *allocator = NULL;
> + match m;
> +
> + m = gfc_match (" (");
> + if (m == MATCH_YES)
> + {
> + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR],
> + true, NULL);
> +
> + if (m != MATCH_YES)
> + {
> + /* If the list was empty, we must find closing ')'. */
> + m = gfc_match (")");
> + if (m != MATCH_YES)
> + return m;
> + }
> + }
> +
> + if (gfc_match (" allocator ( ") == MATCH_YES)
> + {
> + m = gfc_match_expr (&allocator);
> + if (m != MATCH_YES)
> + {
> + gfc_error ("Expected allocator at %C");
> + return MATCH_ERROR;
> + }
> + if (gfc_match (" ) ") != MATCH_YES)
> + {
> + gfc_error ("Expected ')' at %C");
> + gfc_free_expr (allocator);
> + return MATCH_ERROR;
> + }
> + }
> +
> + if (gfc_match_omp_eos () != MATCH_YES)
> + {
> + gfc_free_expr (allocator);
> + gfc_error ("Unexpected junk after $OMP allocate at %C");
> + return MATCH_ERROR;
> + }
> + gfc_omp_namelist *n;
> + for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
> + n->expr = gfc_copy_expr (allocator);
> +
> + new_st.op = EXEC_OMP_ALLOCATE;
> + new_st.ext.omp_clauses = c;
> + gfc_free_expr (allocator);
> + return MATCH_YES;
> +}
> +
>
> /* omp atomic [clause-list]
> - atomic-clause: read | write | update
> @@ -6243,7 +6303,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
> "IN_REDUCTION", "TASK_REDUCTION",
> "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
> "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
> - "NONTEMPORAL" };
> + "NONTEMPORAL", "ALLOCATOR" };
> STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
>
> if (omp_clauses == NULL)
> @@ -8507,6 +8567,8 @@ omp_code_to_statement (gfc_code *code)
> {
> switch (code->op)
> {
> + case EXEC_OMP_ALLOCATE:
> + return ST_OMP_ALLOCATE;
> case EXEC_OMP_PARALLEL:
> return ST_OMP_PARALLEL;
> case EXEC_OMP_PARALLEL_MASKED:
> @@ -8987,6 +9049,138 @@ gfc_resolve_oacc_routines (gfc_namespace *ns)
> }
> }
>
> +static void
> +check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al,
> + gfc_namespace *ns, locus loc)
> +{
> + if (sym->attr.save != SAVE_NONE || sym->attr.in_common == 1
> + || sym->module != NULL)
> + {
> + int tmp;
> + /* Assumption here is that we can extract an integer then
> + it is a predefined thing. */
> + if (!omp_al || gfc_extract_int (omp_al, &tmp))
> + gfc_error ("%qs should use predefined allocator at %L", sym->name,
> + &loc);
> + }
> + if (ns != sym->ns)
> + gfc_error ("%qs is not in the same scope as %<allocate%>"
> + " directive at %L", sym->name, &loc);
> +}
> +
> +#define EMPTY_VAR_LIST(node) \
> + (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL)
> +
> +static void
> +gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
> +{
> + gfc_alloc *al;
> + gfc_omp_namelist *n = NULL;
> + gfc_omp_namelist *cn = NULL;
> + gfc_omp_namelist *p, *tail;
> + gfc_code *cur;
> + hash_set<gfc_symbol*> vars;
> +
> + gfc_omp_clauses *clauses = code->ext.omp_clauses;
> + gcc_assert (clauses);
> + cn = clauses->lists[OMP_LIST_ALLOCATOR];
> + gfc_expr *omp_al = cn ? cn->expr : NULL;
> +
> + if (omp_al && (omp_al->ts.type != BT_INTEGER
> + || omp_al->ts.kind != gfc_c_intptr_kind))
> + gfc_error ("Expected integer expression of the "
> + "%<omp_allocator_handle_kind%> kind at %L", &omp_al->where);
> +
> + /* Check that variables in this allocate directive are not duplicated
> + in this directive or others coming directly after it. */
> + for (cur = code; cur != NULL && cur->op == EXEC_OMP_ALLOCATE;
> + cur = cur->next)
> + {
> + gfc_omp_clauses *c = cur->ext.omp_clauses;
> + gcc_assert (c);
> + for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
> + {
> + if (vars.contains (n->sym))
> + gfc_error ("%qs is used in multiple %<allocate%> "
> + "directives at %L", n->sym->name, &cur->loc);
> + /* This helps us avoid duplicate error messages. */
> + if (cur == code)
> + vars.add (n->sym);
> + }
> + }
> +
> + if (cur == NULL || cur->op != EXEC_ALLOCATE)
> + {
> + /* There is no allocate statement right after allocate directive.
> + We don't support this case at the moment. */
> + for (n = cn; n != NULL; n = n->next)
> + {
> + gfc_symbol *sym = n->sym;
> + if (sym->attr.allocatable == 1)
> + gfc_error ("%qs with ALLOCATABLE attribute is not allowed in "
> + "%<allocate%> directive at %L as this directive is not"
> + " associated with an %<allocate%> statement.",
> + sym->name, &code->loc);
> + }
> + sorry_at (code->loc.lb->location, "%<allocate%> directive that is "
> + "not associated with an %<allocate%> statement is not "
> + "supported.");
> + return;
> + }
> +
> + /* If there is another allocate directive right after this one, check
> + that none of them is empty. Doing it this way, we can check this
> + thing even when multiple directives are together and generate
> + error at right location. */
> + if (code->next && code->next->op == EXEC_OMP_ALLOCATE
> + && (EMPTY_VAR_LIST (code) || EMPTY_VAR_LIST (code->next)))
> + gfc_error ("Empty variable list is not allowed at %L when multiple "
> + "%<allocate%> directives are associated with an "
> + "%<allocate%> statement.",
> + EMPTY_VAR_LIST (code) ? &code->loc : &code->next->loc);
> +
> + if (EMPTY_VAR_LIST (code))
> + {
> + /* Empty namelist means allocate directive applies to all
> + variables in allocate statement. 'cur' points to associated
> + allocate statement. */
> + for (al = cur->ext.alloc.list; al != NULL; al = al->next)
> + if (al->expr && al->expr->symtree && al->expr->symtree->n.sym)
> + {
> + check_allocate_directive_restrictions (al->expr->symtree->n.sym,
> + omp_al, ns, code->loc);
> + p = gfc_get_omp_namelist ();
> + p->sym = al->expr->symtree->n.sym;
> + p->expr = omp_al;
> + p->where = code->loc;
> + if (cn == NULL)
> + cn = tail = p;
> + else
> + {
> + tail->next = p;
> + tail = tail->next;
> + }
> + }
> + clauses->lists[OMP_LIST_ALLOCATOR]= cn;
> + }
> + else
> + {
> + for (n = cn; n != NULL; n = n->next)
> + {
> + for (al = cur->ext.alloc.list; al != NULL; al = al->next)
> + if (al->expr && al->expr->symtree && al->expr->symtree->n.sym
> + && al->expr->symtree->n.sym == n->sym)
> + break;
> + if (al == NULL)
> + gfc_error ("%qs in %<allocate%> directive at %L is not present "
> + "in associated %<allocate%> statement.",
> + n->sym->name, &code->loc);
> + check_allocate_directive_restrictions (n->sym, omp_al, ns,
> + code->loc);
> + }
> + }
> +}
> +
>
> void
> gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
> @@ -9128,6 +9322,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
> code->ext.omp_clauses->if_present = false;
> resolve_omp_clauses (code, code->ext.omp_clauses, ns);
> break;
> + case EXEC_OMP_ALLOCATE:
> + gfc_resolve_omp_allocate (code, ns);
> + break;
> default:
> break;
> }
> diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
> index c04ad774f25..fda36433129 100644
> --- a/gcc/fortran/parse.c
> +++ b/gcc/fortran/parse.c
> @@ -886,6 +886,7 @@ decode_omp_directive (void)
> {
> case 'a':
> matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
> + matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
> break;
> case 'b':
> matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
> @@ -1672,9 +1673,9 @@ next_statement (void)
> case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
> case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
> case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
> - case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
> - case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
> - case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
> + case ST_OMP_ALLOCATE: case ST_ERROR_STOP: case ST_OMP_SCAN: \
> + case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: \
> + case ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
> case ST_END_TEAM: case ST_SYNC_TEAM: \
> case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
> case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
> @@ -2351,6 +2352,9 @@ gfc_ascii_statement (gfc_statement st)
> case ST_OACC_END_ATOMIC:
> p = "!$ACC END ATOMIC";
> break;
> + case ST_OMP_ALLOCATE:
> + p = "!$OMP ALLOCATE";
> + break;
> case ST_OMP_ATOMIC:
> p = "!$OMP ATOMIC";
> break;
> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
> index 43eeefee07f..991cd4fe874 100644
> --- a/gcc/fortran/resolve.c
> +++ b/gcc/fortran/resolve.c
> @@ -12306,6 +12306,7 @@ start:
> gfc_resolve_oacc_directive (code, ns);
> break;
>
> + case EXEC_OMP_ALLOCATE:
> case EXEC_OMP_ATOMIC:
> case EXEC_OMP_BARRIER:
> case EXEC_OMP_CANCEL:
> diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
> index 73f30c2137f..7b282e96c3d 100644
> --- a/gcc/fortran/st.c
> +++ b/gcc/fortran/st.c
> @@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p)
> case EXEC_OACC_ENTER_DATA:
> case EXEC_OACC_EXIT_DATA:
> case EXEC_OACC_ROUTINE:
> + case EXEC_OMP_ALLOCATE:
> case EXEC_OMP_ATOMIC:
> case EXEC_OMP_CANCEL:
> case EXEC_OMP_CANCELLATION_POINT:
> diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
> index 26f0815b5ea..a2248c83623 100644
> --- a/gcc/fortran/trans.c
> +++ b/gcc/fortran/trans.c
> @@ -2140,6 +2140,7 @@ trans_code (gfc_code * code, tree cond)
> res = gfc_trans_dt_end (code);
> break;
>
> + case EXEC_OMP_ALLOCATE:
> case EXEC_OMP_ATOMIC:
> case EXEC_OMP_BARRIER:
> case EXEC_OMP_CANCEL:
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> new file mode 100644
> index 00000000000..3f512d66495
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> @@ -0,0 +1,112 @@
> +! { dg-do compile }
> +
> +module test
> + integer, allocatable :: mvar1
> + integer, allocatable :: mvar2
> + integer, allocatable :: mvar3
> +end module
> +
> +subroutine foo(x, y)
> + use omp_lib
> + implicit none
> + integer :: x
> + integer :: y
> +
> + integer, allocatable :: var1(:)
> + integer, allocatable :: var2(:)
> + integer, allocatable :: var3(:)
> + integer, allocatable :: var4(:)
> + integer, allocatable :: var5(:)
> + integer, allocatable :: var6(:)
> + integer, allocatable :: var7(:)
> + integer, allocatable :: var8(:)
> + integer, allocatable :: var9(:)
> +
> + !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
> + allocate (var1(x))
> +
> + !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
> + allocate (var3(x))
> +
> + !$omp allocate (x) ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." }
> + x = 2
> +
> + !$omp allocate (var4) ! { dg-error "'var4' with ALLOCATABLE attribute is not allowed in 'allocate' directive at .1. as this directive is not associated with an 'allocate' statement." }
> + ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." "" { target *-*-* } .-1 }
> + y = 2
> +
> + !$omp allocate (var5)
> + !$omp allocate ! { dg-error "Empty variable list is not allowed at .1. when multiple 'allocate' directives are associated with an 'allocate' statement." }
> + allocate (var5(x))
> +
> + !$omp allocate (var6)
> + !$omp allocate (var7) ! { dg-error "'var7' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
> + !$omp allocate (var8) ! { dg-error "'var8' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
> + allocate (var6(x))
> +
> + !$omp allocate (var9)
> + !$omp allocate (var9) ! { dg-error "'var9' is used in multiple 'allocate' directives at .1." }
> + allocate (var9(x))
> +
> +end subroutine
> +
> +function outer(a)
> + IMPLICIT NONE
> +
> + integer :: outer, a
> + integer, allocatable :: var1
> +
> + outer = inner(a) + 5
> + return
> +
> + contains
> +
> + integer function inner(x)
> + integer :: x
> + integer, allocatable :: var2
> +
> + !$omp allocate (var1, var2) ! { dg-error "'var1' is not in the same scope as 'allocate' directive at .1." }
> + allocate (var1, var2)
> +
> + inner = x + 10
> + return
> + end function inner
> +
> +end function outer
> +
> +subroutine bar(s)
> + use omp_lib
> + use test
> + integer :: s
> + integer, save, allocatable :: svar1
> + integer, save, allocatable :: svar2
> + integer, save, allocatable :: svar3
> +
> + 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
> +
> + !$omp allocate (mvar1) allocator(a) ! { dg-error "'mvar1' should use predefined allocator at .1." }
> + allocate (mvar1)
> +
> + !$omp allocate (mvar2) ! { dg-error "'mvar2' should use predefined allocator at .1." }
> + allocate (mvar2)
> +
> + !$omp allocate (mvar3) allocator(omp_low_lat_mem_alloc)
> + allocate (mvar3)
> +
> + !$omp allocate (svar1) allocator(a) ! { dg-error "'svar1' should use predefined allocator at .1." }
> + allocate (svar1)
> +
> + !$omp allocate (svar2) ! { dg-error "'svar2' should use predefined allocator at .1." }
> + allocate (svar2)
> +
> + !$omp allocate (svar3) allocator(omp_low_lat_mem_alloc)
> + allocate (svar3)
> +end subroutine
> +
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
> new file mode 100644
> index 00000000000..761b6dede28
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
> @@ -0,0 +1,73 @@
> +! { dg-do compile }
> +
> +module omp_lib_kinds
> + use iso_c_binding, only: c_int, c_intptr_t
> + implicit none
> + private :: c_int, c_intptr_t
> + integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_null_allocator = 0
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_default_mem_alloc = 1
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_large_cap_mem_alloc = 2
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_const_mem_alloc = 3
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_high_bw_mem_alloc = 4
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_low_lat_mem_alloc = 5
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_cgroup_mem_alloc = 6
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_pteam_mem_alloc = 7
> + integer (kind=omp_allocator_handle_kind), &
> + parameter :: omp_thread_mem_alloc = 8
> +end module
> +
> +subroutine foo(x, y)
> + use omp_lib_kinds
> + implicit none
> + integer :: x
> + integer :: y
> +
> + integer, allocatable :: var1(:)
> + integer, allocatable :: var2(:)
> + integer, allocatable :: var3(:)
> + integer, allocatable :: var4(:,:)
> + integer, allocatable :: var5(:)
> + integer, allocatable :: var6(:)
> + integer, allocatable :: var7(:)
> + integer, allocatable :: var8(:)
> + integer, allocatable :: var9(:)
> + integer, allocatable :: var10(:)
> + integer, allocatable :: var11(:)
> + integer, allocatable :: var12(:)
> +
> + !$omp allocate (var1) allocator(omp_default_mem_alloc)
> + allocate (var1(x))
> +
> + !$omp allocate (var2)
> + allocate (var2(x))
> +
> + !$omp allocate (var3, var4) allocator(omp_large_cap_mem_alloc)
> + allocate (var3(x),var4(x,y))
> +
> + !$omp allocate()
> + allocate (var5(x))
> +
> + !$omp allocate
> + allocate (var6(x))
> +
> + !$omp allocate () allocator(omp_default_mem_alloc)
> + allocate (var7(x))
> +
> + !$omp allocate allocator(omp_default_mem_alloc)
> + allocate (var8(x))
> +
> + !$omp allocate (var9) allocator(omp_default_mem_alloc)
> + !$omp allocate (var10) allocator(omp_large_cap_mem_alloc)
> + allocate (var9(x), var10(x))
> +
> +end subroutine
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: 0001-Fix-omp_allocator_handle_kind-example-in-gfortr.og12.patch --]
[-- Type: text/x-diff, Size: 3777 bytes --]
From e07fb2a36377a6504dda088f0a1c5185ff51d652 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Wed, 1 Feb 2023 12:30:28 +0100
Subject: [PATCH] Fix 'omp_allocator_handle_kind' example in
'gfortran.dg/gomp/allocate-4.f90'
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
I've noticed that while 'gfortran.dg/gomp/allocate-4.f90' is all-PASS for
x86_64-pc-linux-gnu (default) '-m64' testing, it does have one FAIL for
'-m32' testing: 'test for errors, line 25'. Here's the 'diff':
@@ -1,8 +1,3 @@
-source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:25:34:
-
- 25 | !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
- | 1
-Error: Expected integer expression of the ‘omp_allocator_handle_kind’ kind at (1)
source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:28:130:
28 | !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
I understand that's due to an "accidental" non-match vs. match of
'10' vs. 'omp_allocator_handle_kind' ('c_intptr_t') data types:
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> +static void
> +gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
> +{
> + gfc_alloc *al;
> + gfc_omp_namelist *n = NULL;
> + gfc_omp_namelist *cn = NULL;
> + gfc_omp_namelist *p, *tail;
> + gfc_code *cur;
> + hash_set<gfc_symbol*> vars;
> +
> + gfc_omp_clauses *clauses = code->ext.omp_clauses;
> + gcc_assert (clauses);
> + cn = clauses->lists[OMP_LIST_ALLOCATOR];
> + gfc_expr *omp_al = cn ? cn->expr : NULL;
> +
> + if (omp_al && (omp_al->ts.type != BT_INTEGER
> + || omp_al->ts.kind != gfc_c_intptr_kind))
> + gfc_error ("Expected integer expression of the "
> + "%<omp_allocator_handle_kind%> kind at %L", &omp_al->where);
$ git grep -i parameter.\*omp_allocator_handle_kind -- libgomp/omp_lib.*
libgomp/omp_lib.f90.in: integer, parameter :: omp_allocator_handle_kind = c_intptr_t
libgomp/omp_lib.h.in: parameter (omp_allocator_handle_kind = @INTPTR_T_KIND@)
Fix-up for og12 commit 491478d12b83e102f72858e8a871a25c951df293
"Add parsing support for allocate directive (OpenMP 5.0)".
gcc/testsuite/
* gfortran.dg/gomp/allocate-4.f90: Fix 'omp_allocator_handle_kind'
example.
---
gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
index 3f512d66495..c9b9c3f6c1d 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
@@ -22,7 +22,12 @@ subroutine foo(x, y)
integer, allocatable :: var8(:)
integer, allocatable :: var9(:)
- !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+ ! Don't do this (..., but it does pass the checks).
+ !$omp allocate (var1) allocator(10_omp_allocator_handle_kind) ! { dg-bogus "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+ allocate (var1(x))
+
+ ! Assumtion is that 'omp_allocator_handle_kind' ('c_intptr_t') isn't 1.
+ !$omp allocate (var1) allocator(10_1) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
allocate (var1(x))
!$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
--
2.25.1
^ permalink raw reply [flat|nested] 15+ messages in thread* Re: [og12] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).)
2023-02-01 11:59 ` [og12] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).) Thomas Schwinge
@ 2023-02-01 12:12 ` Tobias Burnus
0 siblings, 0 replies; 15+ messages in thread
From: Tobias Burnus @ 2023-02-01 12:12 UTC (permalink / raw)
To: Thomas Schwinge, Hafiz Abid Qadeer, gcc-patches, fortran; +Cc: Jakub Jelinek
Hi Thomas,
On 01.02.23 12:59, Thomas Schwinge wrote:
> + ! Don't do this (..., but it does pass the checks).
> + !$omp allocate (var1) allocator(10_omp_allocator_handle_kind) ! { dg-bogus "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
> + allocate (var1(x))
> +
> + ! Assumtion is that 'omp_allocator_handle_kind' ('c_intptr_t') isn't 1.
> + !$omp allocate (var1) allocator(10_1) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
> allocate (var1(x))
s/Don't do this/Don't use a hard-coded value/ (or something like that)
s/Assumtion/Assumption/
Otherwise, LGTM. (Especially it is both only a testcase and only on OG12.)
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
^ permalink raw reply [flat|nested] 15+ messages in thread
* [og12] 'gfortran.dg/gomp/allocate-4.f90' -> 'libgomp.fortran/allocate-5.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0))
2022-01-13 14:53 ` [PATCH 1/5] [gfortran] Add parsing support " Hafiz Abid Qadeer
2022-10-11 12:13 ` Jakub Jelinek
2023-02-01 11:59 ` [og12] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).) Thomas Schwinge
@ 2023-02-09 11:35 ` Thomas Schwinge
2 siblings, 0 replies; 15+ messages in thread
From: Thomas Schwinge @ 2023-02-09 11:35 UTC (permalink / raw)
To: gcc-patches, Andrew Stubbs; +Cc: Hafiz Abid Qadeer, fortran, jakub, tobias
[-- Attachment #1: Type: text/plain, Size: 913 bytes --]
Hi!
On 2022-01-13T14:53:16+0000, Hafiz Abid Qadeer <abidh@codesourcery.com> wrote:
> [...]
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> + use omp_lib
Pushed to devel/omp/gcc-12 branch
commit 7e1963a4e6ac97b6629c1e9e858ae28487f518cf
"'gfortran.dg/gomp/allocate-4.f90' -> 'libgomp.fortran/allocate-5.f90'",
see attached.
Note that this likewise applies to the current upstream submission:
<https://inbox.sourceware.org/gcc-patches/c00649080f9127a0eeabb45536a2846ffc4c3fa7.1657188329.git.ams@codesourcery.com>
"Add parsing support for allocate directive (OpenMP 5.0)".
Grüße
Thomas
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-gfortran.dg-gomp-allocate-4.f90-libgomp.fortran-allo.patch --]
[-- Type: text/x-diff, Size: 2313 bytes --]
From 7e1963a4e6ac97b6629c1e9e858ae28487f518cf Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Mon, 30 Jan 2023 18:04:16 +0100
Subject: [PATCH] 'gfortran.dg/gomp/allocate-4.f90' ->
'libgomp.fortran/allocate-5.f90'
Otherwise, for build-tree testing:
[...]/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:10:7: Fatal Error: Cannot open module file 'omp_lib.mod' for reading at (1): No such file or directory
..., and thus corresponding FAILs.
(Not renamed to 'libgomp.fortran/allocate-4.f90', as that one already exists.)
Fix-up for og12 commit 491478d12b83e102f72858e8a871a25c951df293
"Add parsing support for allocate directive (OpenMP 5.0)".
gcc/testsuite/
* gfortran.dg/gomp/allocate-4.f90: Cut.
libgomp/
* testsuite/libgomp.fortran/allocate-5.f90: Paste.
---
gcc/testsuite/ChangeLog.omp | 2 ++
libgomp/ChangeLog.omp | 2 ++
.../testsuite/libgomp.fortran/allocate-5.f90 | 0
3 files changed, 4 insertions(+)
rename gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 => libgomp/testsuite/libgomp.fortran/allocate-5.f90 (100%)
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 936e7af0945..f0c58e4d26a 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,5 +1,7 @@
2023-02-09 Thomas Schwinge <thomas@codesourcery.com>
+ * gfortran.dg/gomp/allocate-4.f90: Cut.
+
* c-c++-common/gomp/uses_allocators-1.c: Cut.
* c-c++-common/gomp/uses_allocators-2.c: Likewise.
* c-c++-common/gomp/uses_allocators-3.c: Likewise.
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 0a3d53602da..603a17e4c8d 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,5 +1,7 @@
2023-02-09 Thomas Schwinge <thomas@codesourcery.com>
+ * testsuite/libgomp.fortran/allocate-5.f90: Paste.
+
* testsuite/libgomp.c++/c++.exp (check_effective_target_c)
(check_effective_target_c++): New.
* testsuite/libgomp.c/c.exp (check_effective_target_c)
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/libgomp/testsuite/libgomp.fortran/allocate-5.f90
similarity index 100%
rename from gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
rename to libgomp/testsuite/libgomp.fortran/allocate-5.f90
--
2.25.1
^ permalink raw reply [flat|nested] 15+ messages in thread
* [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0).
2022-01-13 14:53 [PATCH 0/5] [gfortran] Support for allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
2022-01-13 14:53 ` [PATCH 1/5] [gfortran] Add parsing support " Hafiz Abid Qadeer
@ 2022-01-13 14:53 ` Hafiz Abid Qadeer
2022-10-11 12:24 ` Jakub Jelinek
2022-01-13 14:53 ` [PATCH 3/5] [gfortran] Handle cleanup of omp allocated variables " Hafiz Abid Qadeer
` (2 subsequent siblings)
4 siblings, 1 reply; 15+ messages in thread
From: Hafiz Abid Qadeer @ 2022-01-13 14:53 UTC (permalink / raw)
To: gcc-patches, fortran; +Cc: tobias, jakub
gcc/fortran/ChangeLog:
* trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
(gfc_trans_omp_allocate): New function.
(gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE.
gcc/ChangeLog:
* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
(dump_generic_node): Handle OMP_ALLOCATE.
* tree.def (OMP_ALLOCATE): New.
* tree.h (OMP_ALLOCATE_CLAUSES): Likewise.
(OMP_ALLOCATE_DECL): Likewise.
(OMP_ALLOCATE_ALLOCATOR): Likewise.
* tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-6.f90: New test.
---
gcc/fortran/trans-openmp.c | 44 ++++++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 72 +++++++++++++++++++
gcc/tree-core.h | 3 +
gcc/tree-pretty-print.c | 19 +++++
gcc/tree.c | 1 +
gcc/tree.def | 4 ++
gcc/tree.h | 11 +++
7 files changed, 154 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 9661c77f905..cb389f40370 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2649,6 +2649,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
break;
+ case OMP_LIST_ALLOCATOR:
+ for (; n != NULL; n = n->next)
+ if (n->sym->attr.referenced)
+ {
+ tree t = gfc_trans_omp_variable (n->sym, false);
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (input_location,
+ OMP_CLAUSE_ALLOCATOR);
+ OMP_ALLOCATE_DECL (node) = t;
+ if (n->expr)
+ {
+ tree allocator_;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, n->expr);
+ allocator_ = gfc_evaluate_now (se.expr, block);
+ OMP_ALLOCATE_ALLOCATOR (node) = allocator_;
+ }
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ }
+ }
+ break;
case OMP_LIST_LINEAR:
{
gfc_expr *last_step_expr = NULL;
@@ -4888,6 +4910,26 @@ gfc_trans_omp_atomic (gfc_code *code)
return gfc_finish_block (&block);
}
+static tree
+gfc_trans_omp_allocate (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt;
+
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
+ gcc_assert (clauses);
+
+ gfc_start_block (&block);
+ stmt = make_node (OMP_ALLOCATE);
+ TREE_TYPE (stmt) = void_type_node;
+ OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses,
+ code->loc, false,
+ true);
+ gfc_add_expr_to_block (&block, stmt);
+ gfc_merge_block_scope (&block);
+ return gfc_finish_block (&block);
+}
+
static tree
gfc_trans_omp_barrier (void)
{
@@ -7280,6 +7322,8 @@ gfc_trans_omp_directive (gfc_code *code)
{
switch (code->op)
{
+ case EXEC_OMP_ALLOCATE:
+ return gfc_trans_omp_allocate (code);
case EXEC_OMP_ATOMIC:
return gfc_trans_omp_atomic (code);
case EXEC_OMP_BARRIER:
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
new file mode 100644
index 00000000000..2de2b52ee44
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -0,0 +1,72 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+module omp_lib_kinds
+ use iso_c_binding, only: c_int, c_intptr_t
+ implicit none
+ private :: c_int, c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module
+
+
+subroutine foo(x, y, al)
+ use omp_lib_kinds
+ implicit none
+
+type :: my_type
+ integer :: i
+ integer :: j
+ real :: x
+end type
+
+ integer :: x
+ integer :: y
+ integer (kind=omp_allocator_handle_kind) :: al
+
+ integer, allocatable :: var1
+ integer, allocatable :: var2
+ real, allocatable :: var3(:,:)
+ type (my_type), allocatable :: var4
+ integer, pointer :: pii, parr(:)
+
+ character, allocatable :: str1a, str1aarr(:)
+ character(len=5), allocatable :: str5a, str5aarr(:)
+
+ !$omp allocate
+ allocate(str1a, str1aarr(10), str5a, str5aarr(10))
+
+ !$omp allocate (var1) allocator(omp_default_mem_alloc)
+ !$omp allocate (var2) allocator(omp_large_cap_mem_alloc)
+ allocate (var1, var2)
+
+ !$omp allocate (var4) allocator(omp_low_lat_mem_alloc)
+ allocate (var4)
+ var4%i = 5
+
+ !$omp allocate (var3) allocator(omp_low_lat_mem_alloc)
+ allocate (var3(x,y))
+
+ !$omp allocate
+ allocate(pii, parr(5))
+end subroutine
+
+! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } }
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 61ae4bd931b..5bd5501e346 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -519,6 +519,9 @@ enum omp_clause_code {
/* OpenACC clause: nohost. */
OMP_CLAUSE_NOHOST,
+
+ /* OpenMP clause: allocator. */
+ OMP_CLAUSE_ALLOCATOR,
};
#undef DEFTREESTRUCT
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index 352662567b4..c3891a359f2 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -740,6 +740,20 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_right_paren (pp);
break;
+ case OMP_CLAUSE_ALLOCATOR:
+ pp_string (pp, "(");
+ dump_generic_node (pp, OMP_ALLOCATE_DECL (clause),
+ spc, flags, false);
+ if (OMP_ALLOCATE_ALLOCATOR (clause))
+ {
+ pp_string (pp, ":allocator(");
+ dump_generic_node (pp, OMP_ALLOCATE_ALLOCATOR (clause),
+ spc, flags, false);
+ pp_right_paren (pp);
+ }
+ pp_right_paren (pp);
+ break;
+
case OMP_CLAUSE_ALLOCATE:
pp_string (pp, "allocate(");
if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (clause))
@@ -3484,6 +3498,11 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
dump_omp_clauses (pp, OACC_CACHE_CLAUSES (node), spc, flags);
break;
+ case OMP_ALLOCATE:
+ pp_string (pp, "#pragma omp allocate ");
+ dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags);
+ break;
+
case OMP_PARALLEL:
pp_string (pp, "#pragma omp parallel");
dump_omp_clauses (pp, OMP_PARALLEL_CLAUSES (node), spc, flags);
diff --git a/gcc/tree.c b/gcc/tree.c
index d98b77db50b..75141756d87 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -363,6 +363,7 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_IF_PRESENT */
0, /* OMP_CLAUSE_FINALIZE */
0, /* OMP_CLAUSE_NOHOST */
+ 2, /* OMP_CLAUSE_ALLOCATOR */
};
const char * const omp_clause_code_name[] =
diff --git a/gcc/tree.def b/gcc/tree.def
index 33eb3b7beff..9768bc29dec 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1301,6 +1301,10 @@ DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1)
DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2)
DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2)
+/* OpenMP - #pragma omp allocate
+ Operand 0: Clauses. */
+DEFTREECODE (OMP_ALLOCATE, "omp allocate", tcc_statement, 1)
+
/* OpenMP clauses. */
DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0)
diff --git a/gcc/tree.h b/gcc/tree.h
index 318019c4dc5..2ec0b8c9240 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1405,6 +1405,8 @@ class auto_suppress_location_wrappers
#define OACC_UPDATE_CLAUSES(NODE) \
TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
+#define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0)
+
#define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0)
#define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1)
@@ -1801,6 +1803,15 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE_ALLOCATE_ALIGN(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE), 2)
+/* May be we can use OMP_CLAUSE_DECL but the I am not sure where to place
+ OMP_CLAUSE_ALLOCATOR in omp_clause_code. */
+
+#define OMP_ALLOCATE_DECL(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 0)
+
+#define OMP_ALLOCATE_ALLOCATOR(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 1)
+
/* True if an ALLOCATE clause was present on a combined or composite
construct and the code for splitting the clauses has already performed
checking if the listed variable has explicit privatization on the
--
2.25.1
^ permalink raw reply [flat|nested] 15+ messages in thread* Re: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0).
2022-01-13 14:53 ` [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
@ 2022-10-11 12:24 ` Jakub Jelinek
2022-10-11 13:22 ` Tobias Burnus
0 siblings, 1 reply; 15+ messages in thread
From: Jakub Jelinek @ 2022-10-11 12:24 UTC (permalink / raw)
To: Hafiz Abid Qadeer; +Cc: gcc-patches, fortran, tobias
On Thu, Jan 13, 2022 at 02:53:17PM +0000, Hafiz Abid Qadeer wrote:
> gcc/fortran/ChangeLog:
>
> * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
> (gfc_trans_omp_allocate): New function.
> (gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE.
>
> gcc/ChangeLog:
>
> * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
> (dump_generic_node): Handle OMP_ALLOCATE.
> * tree.def (OMP_ALLOCATE): New.
> * tree.h (OMP_ALLOCATE_CLAUSES): Likewise.
> (OMP_ALLOCATE_DECL): Likewise.
> (OMP_ALLOCATE_ALLOCATOR): Likewise.
> * tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/gomp/allocate-6.f90: New test.
There is another issue besides what I wrote in my last review,
and I'm afraid I don't know what to do about it, hoping Tobias
has some ideas.
The problem is that without the allocate-stmt associated allocate directive,
Fortran allocatables are easily always allocated with malloc and freed with
free. The deallocation can be implicit through reallocation, or explicit
deallocate statement etc.
But when some allocatables are now allocated with a different
allocator (when allocate-stmt associated allocate directive is used),
some allocatables are allocated with malloc and others with GOMP_alloc
but we need to free them with the corresponding allocator based on how
they were allocated, what has been allocated with malloc should be
deallocated with free, what has been allocated with GOMP_alloc should be
deallocated with GOMP_free.
The deallocation can be done in a completely different TU from where it has
been allocated, in theory it could be also not compiled with -fopenmp, etc.
So, I'm afraid we need to store somewhere whether we used malloc or
GOMP_alloc for the allocation (say somewhere in the array descriptor and for
other stuff somewhere on the side?) and slow down all code that needs
deallocation to check that bit (or say we don't support
deallocation/reallocation of OpenMP allocated allocatables without -fopenmp
on the deallocation TU and only slow down -fopenmp compiled code)?
Tobias, thoughts on this?
Jakub
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0).
2022-10-11 12:24 ` Jakub Jelinek
@ 2022-10-11 13:22 ` Tobias Burnus
2022-10-11 14:15 ` Jakub Jelinek
0 siblings, 1 reply; 15+ messages in thread
From: Tobias Burnus @ 2022-10-11 13:22 UTC (permalink / raw)
To: Jakub Jelinek, Hafiz Abid Qadeer; +Cc: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 5714 bytes --]
Hi Jakub,
On 11.10.22 14:24, Jakub Jelinek wrote:
There is another issue besides what I wrote in my last review,
and I'm afraid I don't know what to do about it, hoping Tobias
has some ideas.
The problem is that without the allocate-stmt associated allocate directive,
Fortran allocatables are easily always allocated with malloc and freed with
free. The deallocation can be implicit through reallocation, or explicit
deallocate statement etc.
...
But when some allocatables are now allocated with a different
allocator (when allocate-stmt associated allocate directive is used),
some allocatables are allocated with malloc and others with GOMP_alloc
but we need to free them with the corresponding allocator based on how
they were allocated, what has been allocated with malloc should be
deallocated with free, what has been allocated with GOMP_alloc should be
deallocated with GOMP_free.
I think the most common case is:
integer, allocatable :: var(:)
!$omp allocators allocator(my_alloc) ! must be in same scope as decl of 'var'
...
! optionally: deallocate(var)
end ! of scope: block/subroutine/... - automatic deallocation
Those can be easily handled. It gets more complicated with control flow:
if (...) then
!$omp allocators allocator(...)
allocate(...)
else
allocate (...)
endif
However, the problem is really that there is is no mandatory
'!$omp deallocators' and also the wording like:
"If any operation of the base language causes a reallocation of
an array that is allocated with a memory allocator then that
memory allocator will be used to release the current memory
and to allocate the new memory." (OpenMP 5.0 wording)
There has been some attempt to relax the rules a bit, e.g. by
adding the wording:
"For allocated allocatable components of such variables, the allocator that
will be used for the deallocation and allocation is unspecified."
And some wording change (→issues 3189) to clarify related component issues.
But nonetheless, there is still the issue of:
(a) explicit DEALLOCATE in some other translation unit
(b) some intrinsic operation which reallocate the memory, either via libgomp
or in the source code:
a = [1,2,3] ! possibly reallocates
str = trim(str) ! possibly reallocates
where the first one calls 'realloc' directly in the code and the second one
calls 'libgomp' for that.
* * *
I don't see a good solution – and there is in principle the same issue with
unified-shared memory (USM) on hardware that does not support transparently
accessing all host memory on the device.
Compilers support this case by allocating memory in some special memory,
which is either accessible from both sides ('pinned') or migrates on the
first access from the device side - but remains there until the accessing
device kernel ends ('managed memory').
Newer hardware (+ associated Linux kernel support) permit accessing all
memory in a somewhat fast way, avoiding this issue (and special handling
is then left to the user.) For AMDGCN, my understanding is that all hardware
supported by GCC supports this - but glacial speed until the last hardware
architectures. For Nvidia, this is supported since Pascal (I think for Titan X,
P100, i.e. sm_5.2/sm_60) - but I believe not for all Pascal/Kepler hardware.
I mention this because the USM implementation at
https://gcc.gnu.org/pipermail/gcc-patches/2022-July/597976.html
suffers from this.
And https://gcc.gnu.org/pipermail/gcc-patches/2022-September/601059.html
tries to solve the the 'trim' example issue above - i.e. the case where
libgomp reallocates pinned/managed (pseudo-)USM memory.
* * *
The deallocation can be done in a completely different TU from where it has
been allocated, in theory it could be also not compiled with -fopenmp, etc.
So, I'm afraid we need to store somewhere whether we used malloc or
GOMP_alloc for the allocation (say somewhere in the array descriptor and for
other stuff somewhere on the side?) and slow down all code that needs
deallocation to check that bit (or say we don't support
deallocation/reallocation of OpenMP allocated allocatables without -fopenmp
on the deallocation TU and only slow down -fopenmp compiled code)?
The problem with storing is that gfortran inserts the malloc/realloc/free calls directly, i.e. without library preloading, intercepting those libcalls, I do not see how it can work at all.
I also do not know how to handle the pinned-memory case above correctly, either.
One partial support would be requiring that the code using allocatables cannot do any reallocation/deallocation by only permitting calls to procedures which do not permit allocatables. (Such that no reallocation can happen.) – And print a 'sorry' for the rest.
Other implementations seem to have a Fortran library call for (re)allocations, which permits to swap the allocator from the generic one to the omp_default_mem_alloc.
* * *
In terms of the array descriptor, we have inside 'struct dtype_type' the 'signed short attribute', which currently only holds CFI_attribute_pointer/CFI_attribute_allocatable/CFI_attribute_other (=0,1,2). And this is only used together with ISO C binding, permitting to use the other bits for other purpose (for the non-ISO-C case). Still, the question is *how* to use it in that case.
Thoughts on the generic issue on those thoughts?
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
^ permalink raw reply [flat|nested] 15+ messages in thread* Re: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0).
2022-10-11 13:22 ` Tobias Burnus
@ 2022-10-11 14:15 ` Jakub Jelinek
2022-10-11 14:27 ` Jakub Jelinek
2022-10-11 14:38 ` Tobias Burnus
0 siblings, 2 replies; 15+ messages in thread
From: Jakub Jelinek @ 2022-10-11 14:15 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Hafiz Abid Qadeer, gcc-patches, fortran
On Tue, Oct 11, 2022 at 03:22:02PM +0200, Tobias Burnus wrote:
> Hi Jakub,
>
> On 11.10.22 14:24, Jakub Jelinek wrote:
>
> There is another issue besides what I wrote in my last review,
> and I'm afraid I don't know what to do about it, hoping Tobias
> has some ideas.
> The problem is that without the allocate-stmt associated allocate directive,
> Fortran allocatables are easily always allocated with malloc and freed with
> free. The deallocation can be implicit through reallocation, or explicit
> deallocate statement etc.
> ...
> But when some allocatables are now allocated with a different
> allocator (when allocate-stmt associated allocate directive is used),
> some allocatables are allocated with malloc and others with GOMP_alloc
> but we need to free them with the corresponding allocator based on how
> they were allocated, what has been allocated with malloc should be
> deallocated with free, what has been allocated with GOMP_alloc should be
> deallocated with GOMP_free.
>
>
>
> I think the most common case is:
>
> integer, allocatable :: var(:)
> !$omp allocators allocator(my_alloc) ! must be in same scope as decl of 'var'
> ...
> ! optionally: deallocate(var)
> end ! of scope: block/subroutine/... - automatic deallocation
So you talk here about the declarative directive the patch does sorry on,
or about the executable one above allocate stmt?
Anyway, even this simple case has the problem that one can have
subroutine foo (var)
integer, allocatable:: var(:)
var = [1, 2, 3] ! reallocate
end subroutine
and call foo (var) above.
> Those can be easily handled. It gets more complicated with control flow:
>
> if (...) then
> !$omp allocators allocator(...)
> allocate(...)
> else
> allocate (...)
> endif
>
>
>
> However, the problem is really that there is is no mandatory
> '!$omp deallocators' and also the wording like:
>
> "If any operation of the base language causes a reallocation of
> an array that is allocated with a memory allocator then that
> memory allocator will be used to release the current memory
> and to allocate the new memory." (OpenMP 5.0 wording)
>
> There has been some attempt to relax the rules a bit, e.g. by
> adding the wording:
> "For allocated allocatable components of such variables, the allocator that
> will be used for the deallocation and allocation is unspecified."
>
> And some wording change (→issues 3189) to clarify related component issues.
>
> But nonetheless, there is still the issue of:
>
> (a) explicit DEALLOCATE in some other translation unit
> (b) some intrinsic operation which reallocate the memory, either via libgomp
> or in the source code:
> a = [1,2,3] ! possibly reallocates
> str = trim(str) ! possibly reallocates
> where the first one calls 'realloc' directly in the code and the second one
> calls 'libgomp' for that.
>
> * * *
>
> I don't see a good solution – and there is in principle the same issue with
> unified-shared memory (USM) on hardware that does not support transparently
> accessing all host memory on the device.
>
> Compilers support this case by allocating memory in some special memory,
> which is either accessible from both sides ('pinned') or migrates on the
> first access from the device side - but remains there until the accessing
> device kernel ends ('managed memory').
>
> Newer hardware (+ associated Linux kernel support) permit accessing all
> memory in a somewhat fast way, avoiding this issue (and special handling
> is then left to the user.) For AMDGCN, my understanding is that all hardware
> supported by GCC supports this - but glacial speed until the last hardware
> architectures. For Nvidia, this is supported since Pascal (I think for Titan X,
> P100, i.e. sm_5.2/sm_60) - but I believe not for all Pascal/Kepler hardware.
>
> I mention this because the USM implementation at
> https://gcc.gnu.org/pipermail/gcc-patches/2022-July/597976.html
> suffers from this.
> And https://gcc.gnu.org/pipermail/gcc-patches/2022-September/601059.html
> tries to solve the the 'trim' example issue above - i.e. the case where
> libgomp reallocates pinned/managed (pseudo-)USM memory.
>
> * * *
>
> The deallocation can be done in a completely different TU from where it has
> been allocated, in theory it could be also not compiled with -fopenmp, etc.
> So, I'm afraid we need to store somewhere whether we used malloc or
> GOMP_alloc for the allocation (say somewhere in the array descriptor and for
> other stuff somewhere on the side?) and slow down all code that needs
> deallocation to check that bit (or say we don't support
> deallocation/reallocation of OpenMP allocated allocatables without -fopenmp
> on the deallocation TU and only slow down -fopenmp compiled code)?
>
> The problem with storing is that gfortran inserts the malloc/realloc/free calls directly, i.e. without library preloading, intercepting those libcalls, I do not see how it can work at all.
Well, it can use a weak symbol, if not linked against libgomp, the bit
that it is OpenMP shouldn't be set and so realloc/free will be used
and do
if (arrdescr.gomp_alloced_bit)
GOMP_free (arrdescr.data, 0);
else
free (arrdescr.data);
and similar. And I think we can just document that we do this only for
-fopenmp compiled code.
But do we have a place to store that bit? I presume in array descriptors
there could be some bit for it, but what to do about scalar allocatables,
or allocatable components etc.?
In theory we could use ugly stuff like if all the allocations would be
guaranteed to have at least 2 byte alignment use LSB bit of the pointer
to mark GOMP_alloc allocated memory for the scalar allocatables etc. but
then would need in -fopenmp compiled code to strip it away.
As for pinned memory, if it is allocated through libgomp allocators, that
should just work if GOMP_free/GOMP_realloc is used, that is why we have
those extra data in front of the allocations where we store everything we
need. But those also make the OpenMP allocations incompatible with
malloc/free allocations.
Jakub
^ permalink raw reply [flat|nested] 15+ messages in thread* Re: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0).
2022-10-11 14:15 ` Jakub Jelinek
@ 2022-10-11 14:27 ` Jakub Jelinek
2022-10-11 14:38 ` Tobias Burnus
1 sibling, 0 replies; 15+ messages in thread
From: Jakub Jelinek @ 2022-10-11 14:27 UTC (permalink / raw)
To: Tobias Burnus, Hafiz Abid Qadeer, gcc-patches, fortran; +Cc: dj, codonell
On Tue, Oct 11, 2022 at 04:15:25PM +0200, Jakub Jelinek wrote:
> Well, it can use a weak symbol, if not linked against libgomp, the bit
> that it is OpenMP shouldn't be set and so realloc/free will be used
> and do
> if (arrdescr.gomp_alloced_bit)
> GOMP_free (arrdescr.data, 0);
> else
> free (arrdescr.data);
> and similar. And I think we can just document that we do this only for
> -fopenmp compiled code.
> But do we have a place to store that bit? I presume in array descriptors
> there could be some bit for it, but what to do about scalar allocatables,
> or allocatable components etc.?
> In theory we could use ugly stuff like if all the allocations would be
> guaranteed to have at least 2 byte alignment use LSB bit of the pointer
> to mark GOMP_alloc allocated memory for the scalar allocatables etc. but
> then would need in -fopenmp compiled code to strip it away.
>
> As for pinned memory, if it is allocated through libgomp allocators, that
> should just work if GOMP_free/GOMP_realloc is used, that is why we have
> those extra data in front of the allocations where we store everything we
> need. But those also make the OpenMP allocations incompatible with
> malloc/free allocations.
Yet another option would be to change the way our OpenMP allocators work,
instead of having allocation internal data before the allocated memory
have them somewhere on the side and use some data structures mapping
ranges of virtual memory to the allocation data.
We'd either need to use mmap to have better control on where exactly
we allocate stuff so that the on the side data structures wouldn't need
to be for every allocation, or do those for every allocation perhaps with
merging of adjacent allocations or something similar.
Disadvantage is that it would be slower and might need more locking etc.,
advantage is that it could be then malloc/free compatible, any not tracked
address would be forwarded from GOMP_free to free etc. And we'd not waste
e.g. precious pinned etc. memory especially when doing allocations with very
high alignment, where the data before allocation means we can waste up to
max (32, alignment - 1) of extra memory. And gfortran
inline emitted reallocation/deallocation could just emit GOMP_realloc/free
always for -fopenmp. The way GOMP_ allocators are currently written, it is
our internal choice if we do it the current way or the on the side way or
some other way, but if we'd guarantee free compatibility we'd make it part
of the ABI.
CCing DJ and Carlos if they have thoughts about this.
The OpenMP spec essentially requires that allocations through its allocator
remember somewhere with which allocator (and its exact properties) each
allocation has been done, so that it can be taken into account during
reallocation or freeing.
Jakub
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0).
2022-10-11 14:15 ` Jakub Jelinek
2022-10-11 14:27 ` Jakub Jelinek
@ 2022-10-11 14:38 ` Tobias Burnus
1 sibling, 0 replies; 15+ messages in thread
From: Tobias Burnus @ 2022-10-11 14:38 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: Hafiz Abid Qadeer, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 4022 bytes --]
On 11.10.22 16:15, Jakub Jelinek wrote:
I think the most common case is:
integer, allocatable :: var(:)
!$omp allocators allocator(my_alloc) ! must be in same scope as decl of 'var'
...
! optionally: deallocate(var)
end ! of scope: block/subroutine/... - automatic deallocation
So you talk here about the declarative directive the patch does sorry on,
or about the executable one above allocate stmt?
Here, I was only talking about the most common usage case, with the
assumption that the user code does not cause any reallocation.
I later talked about accepting only code which cannot cause
reallocation (compile-time check of the code contained in the
scope).
Thus, a 'call foo(a)' would be fine, but not for ...
Anyway, even this simple case has the problem that one can have
subroutine foo (var)
integer, allocatable:: var(:)
a 'foo' that has an 'allocatable' attribute for the dummy argument.
I think in the common case, it has not – such that most code can run w/o running into this issue.
However, for code like
type t
real, allocatable :: x(:), y(:), z(:)
end type t
type(t) :: var
!$omp allocators(my_alloc)
allocate(var%x(N), var%y(N), var%z(N))
call bar(var%x)
call foo(var)
it is more difficult: 'bar' works (if its dummy argument is not 'allocatable')
but for 'foo', the (re|de)allocation cannot be ruled out.
Thus, we always have to 'sorry' for such a code – and I fear it could be somewhat
common.
Well, it can use a weak symbol, if not linked against libgomp, the bit
that it is OpenMP shouldn't be set and so realloc/free will be used
and do
if (arrdescr.gomp_alloced_bit)
GOMP_free (arrdescr.data, 0);
else
free (arrdescr.data);
and similar. And I think we can just document that we do this only for
-fopenmp compiled code.
But do we have a place to store that bit?
I presume in array descriptors
there could be some bit for it, but what to do about scalar allocatables,
or allocatable components etc.?
As mentioned, we could use the 'dtype.attribute' field which is currently not really used – and if, only 2 of the 16 bits are used. But you are right that for scalar allocatables, we do not use array descriptors (except with BIND(C)). Hmm.
For allocatable components, the same applied: If arrays, then there is an array descriptor – for scalars, there isn't. (And storing the length of a scalar character string with deferred length uses an aux variable + has lots of bugs.)
In theory we could use ugly stuff like if all the allocations would be
guaranteed to have at least 2 byte alignment use LSB bit of the pointer
to mark GOMP_alloc allocated memory for the scalar allocatables etc. but
then would need in -fopenmp compiled code to strip it away.
I think we could do tricks with scalar allocatable variable – but it will be more complicated with scalar allocatable components. Hmm.
As for pinned memory, if it is allocated through libgomp allocators, that
should just work if GOMP_free/GOMP_realloc is used, that is why we have
those extra data in front of the allocations where we store everything we
need. But those also make the OpenMP allocations incompatible with
malloc/free allocations.
The problem of making pseudo-USM work is that it has to be applied to all (stack,heap) memory – which implies that all code using malloc/free needs to be either call the GOMP version or the GLIBC version, but shall not mix one or the other. – Thus, calling some library or any other file that was not compiled with -f... will have issues with malloc/free. Another issue is that variables not allocated via GOMP_* will not be accessible on the device in that case.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
^ permalink raw reply [flat|nested] 15+ messages in thread
* [PATCH 3/5] [gfortran] Handle cleanup of omp allocated variables (OpenMP 5.0).
2022-01-13 14:53 [PATCH 0/5] [gfortran] Support for allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
2022-01-13 14:53 ` [PATCH 1/5] [gfortran] Add parsing support " Hafiz Abid Qadeer
2022-01-13 14:53 ` [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
@ 2022-01-13 14:53 ` Hafiz Abid Qadeer
2022-01-13 14:53 ` [PATCH 4/5] [gfortran] Gimplify allocate directive " Hafiz Abid Qadeer
2022-01-13 14:53 ` [PATCH 5/5] [gfortran] Lower " Hafiz Abid Qadeer
4 siblings, 0 replies; 15+ messages in thread
From: Hafiz Abid Qadeer @ 2022-01-13 14:53 UTC (permalink / raw)
To: gcc-patches, fortran; +Cc: tobias, jakub
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.
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.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/openmp.c | 30 +++++++++++++++++++
gcc/fortran/trans-decl.c | 20 +++++++++++++
gcc/fortran/trans-openmp.c | 6 ++++
gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 3 +-
gcc/tree-core.h | 6 ++++
gcc/tree-pretty-print.c | 4 +++
gcc/tree.h | 4 +++
8 files changed, 73 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 79a43a2fdf0..6a43847d31f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1820,6 +1820,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 ee7c39980bb..f11812b0b12 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5818,6 +5818,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;
}
@@ -9049,6 +9050,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)
@@ -9179,6 +9208,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 066fb3a5f61..e5c9bf413e7 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4583,6 +4583,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 cb389f40370..12abc840642 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4925,6 +4925,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/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 5bd5501e346..21b9a9a761b 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -1241,6 +1241,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
@@ -1267,6 +1270,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 c3891a359f2..ae8623fe806 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -3500,6 +3500,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 2ec0b8c9240..4d099c9bf12 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1406,6 +1406,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)
--
2.25.1
^ permalink raw reply [flat|nested] 15+ messages in thread* [PATCH 4/5] [gfortran] Gimplify allocate directive (OpenMP 5.0).
2022-01-13 14:53 [PATCH 0/5] [gfortran] Support for allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
` (2 preceding siblings ...)
2022-01-13 14:53 ` [PATCH 3/5] [gfortran] Handle cleanup of omp allocated variables " Hafiz Abid Qadeer
@ 2022-01-13 14:53 ` Hafiz Abid Qadeer
2022-01-13 14:53 ` [PATCH 5/5] [gfortran] Lower " Hafiz Abid Qadeer
4 siblings, 0 replies; 15+ messages in thread
From: Hafiz Abid Qadeer @ 2022-01-13 14:53 UTC (permalink / raw)
To: gcc-patches, fortran; +Cc: tobias, jakub
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
^ permalink raw reply [flat|nested] 15+ messages in thread* [PATCH 5/5] [gfortran] Lower allocate directive (OpenMP 5.0).
2022-01-13 14:53 [PATCH 0/5] [gfortran] Support for allocate directive (OpenMP 5.0) Hafiz Abid Qadeer
` (3 preceding siblings ...)
2022-01-13 14:53 ` [PATCH 4/5] [gfortran] Gimplify allocate directive " Hafiz Abid Qadeer
@ 2022-01-13 14:53 ` Hafiz Abid Qadeer
4 siblings, 0 replies; 15+ messages in thread
From: Hafiz Abid Qadeer @ 2022-01-13 14:53 UTC (permalink / raw)
To: gcc-patches, fortran; +Cc: tobias, jakub
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-1.c: New test.
* testsuite/libgomp.fortran/allocate-2.f90: New test.
---
gcc/omp-low.c | 125 ++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 9 ++
.../testsuite/libgomp.fortran/allocate-1.c | 7 +
.../testsuite/libgomp.fortran/allocate-2.f90 | 49 +++++++
4 files changed, 190 insertions(+)
create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c
create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-2.f90
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index f2237428de1..8a0ae3932b9 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1684,6 +1684,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:
@@ -1892,6 +1893,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__CACHE_:
@@ -2962,6 +2964,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
@@ -4247,6 +4259,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;
@@ -8680,6 +8695,111 @@ 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 *)
+{
+ 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;
+ 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:
@@ -14179,6 +14299,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/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
index 6957bc55da0..738d9936f6a 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/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c
new file mode 100644
index 00000000000..d33acc6feef
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+int
+is_64bit_aligned_ (uintptr_t a)
+{
+ return ( (a & 0x3f) == 0);
+}
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-2.f90 b/libgomp/testsuite/libgomp.fortran/allocate-2.f90
new file mode 100644
index 00000000000..8678c53a34c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-2.f90
@@ -0,0 +1,49 @@
+! { 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
+end module m
+
+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
+
+program main
+ use omp_lib
+ 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
--
2.25.1
^ permalink raw reply [flat|nested] 15+ messages in thread