Hi Jakub Thanks for the review. Please see comments inline. Also note that common block is now allowed in allocate clause as per your comment so there is slight adjustment in the parsing code for that.
On 20/12/2021 20:06, Jakub Jelinek wrote: > On Thu, Nov 18, 2021 at 07:30:36PM +0000, Hafiz Abid Qadeer wrote: >> + if (gfc_match (" : ") != MATCH_YES) >> + { >> + /* If no ":" then there is no allocator, we backtrack >> + and read the variable list. */ >> + gfc_free_expr (allocator); >> + allocator = NULL; >> + gfc_current_locus = old_loc; >> + } > > Ok, no leak above. > >> + >> + gfc_omp_namelist **head = NULL; >> + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], >> + false, NULL, &head); >> + >> + if (m == MATCH_ERROR) >> + break; > > But here it leaks. Just call gfc_free_expr (allocator); before break. Done. Although code is a bit different from the last patch. > >> + >> + gfc_omp_namelist *n; >> + for (n = *head; n; n = n->next) >> + if (allocator) >> + n->expr = gfc_copy_expr (allocator); >> + else >> + n->expr = NULL; >> + gfc_free_expr (allocator); >> + continue; >> + } >> if ((mask & OMP_CLAUSE_AT) >> && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) >> != MATCH_NO) > >> + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) >> + { >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + if (n->expr && (n->expr->ts.type != BT_INTEGER >> + || n->expr->ts.kind != gfc_c_intptr_kind)) >> + { >> + gfc_error ("Expected integer expression of the " >> + "'omp_allocator_handle_kind' kind at %L", &n->expr->where); > > Formatting, "' should be indented below "Expected Done. > >> + break; >> + } >> + >> + /* Check for 2 things here. >> + 1. There is no duplication of variable in allocate clause. >> + 2. Variable in allocate clause are also present in some >> + privatization clase (non-composite case). */ >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + n->sym->omp_allocate_clause = 0; >> + >> + gfc_omp_namelist *prev = NULL; >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) >> + { >> + if (n->sym->omp_allocate_clause == 1) >> + { >> + gfc_warning (0, "%qs appears more than once in %<allocate%> " >> + "clauses at %L" , n->sym->name, &n->where); >> + /* We have already seen this variable so it is a duplicate. >> + Remove it. */ >> + if (prev != NULL && prev->next == n) >> + { >> + prev->next = n->next; >> + n->next = NULL; >> + gfc_free_omp_namelist (n, 0); >> + n = prev->next; >> + } >> + continue; >> + } >> + n->sym->omp_allocate_clause = 1; >> + prev = n; >> + n = n->next; >> + } >> + >> + /* non-composite constructs. */ >> + if (code && code->op < EXEC_OMP_DO_SIMD) >> + { >> + for (list = 0; list < OMP_LIST_NUM; list++) >> + switch (list) >> + { >> + case OMP_LIST_PRIVATE: >> + case OMP_LIST_FIRSTPRIVATE: >> + case OMP_LIST_LASTPRIVATE: >> + case OMP_LIST_REDUCTION: >> + case OMP_LIST_REDUCTION_INSCAN: >> + case OMP_LIST_REDUCTION_TASK: >> + case OMP_LIST_IN_REDUCTION: >> + case OMP_LIST_TASK_REDUCTION: >> + case OMP_LIST_LINEAR: >> + for (n = omp_clauses->lists[list]; n; n = n->next) >> + n->sym->omp_allocate_clause = 0; >> + break; >> + default: >> + break; >> + } >> + >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + if (n->sym->omp_allocate_clause == 1) >> + gfc_error ("%qs specified in 'allocate' clause at %L but not " >> + "in an explicit privatization clause", >> + n->sym->name, &n->where); >> + } >> + } > > Do you really need a new omp_allocate_clause bit? From what I can see, > other code uses n->sym->mark for such purposes (temporarily marking some > symbols). Done. > Also, I think allocate clause like the privatization clauses should allow > common blocks and I see code that uses the marks uses something like: > for (list = OMP_LIST_TO; list != OMP_LIST_NUM; > list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) > for (n = c->lists[list]; n; n = n->next) > if (n->sym) > n->sym->mark = 0; > else if (n->u.common->head) > n->u.common->head->mark = 0; > So, a question is if the above won't just crash if I specify > firstprivate(/foobar/) allocate(/foobar/) > etc. I don't think we need to go and check n->u.common->head as gfc_match_omp_variable_list has already done it for us. I have added tests to check allocate clause with common blocks and it works fine. > >> + case OMP_LIST_ALLOCATE: >> + for (; n != NULL; n = n->next) >> + if (n->sym->attr.referenced || declare_simd) > > !$omp declare simd doesn't allow allocate clause, so why the > above " || declare_simd"? It was an oversight. Fixed now. > >> + { >> + tree t = gfc_trans_omp_variable (n->sym, declare_simd); > > And not , false); above? Done. Thanks, -- Hafiz Abid Qadeer Mentor, a Siemens Business
>From d1fb55bff497a20e6feefa50bd03890e7a903c0e Mon Sep 17 00:00:00 2001 From: Hafiz Abid Qadeer <ab...@codesourcery.com> Date: Fri, 24 Sep 2021 10:04:12 +0100 Subject: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not yet support the allocator-modifier as specified in OpenMP 5.1. The allocate clause is already supported in C/C++. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. * gfortran.h (OMP_LIST_ALLOCATE): New enum value. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. (OMP_TASKGROUP_CLAUSES): New. (gfc_match_omp_taskgroup): Use OMP_TASKGROUP_CLAUSES instead of OMP_CLAUSE_TASK_REDUCTION. (resolve_omp_clauses): Handle OMP_LIST_ALLOCATE. (resolve_omp_do): Avoid warning when loop iteration variable is in allocate clause. * trans-openmp.c (gfc_trans_omp_clauses): Handle translation of allocate clause. (gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-1.f90: New test. * gfortran.dg/gomp/allocate-2.f90: New test. * gfortran.dg/gomp/allocate-3.f90: New test. * gfortran.dg/gomp/collapse1.f90: Update error message. * gfortran.dg/gomp/openmp-simd-4.f90: Likewise. * gfortran.dg/gomp/clauses-1.f90: Uncomment allocate clause. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.c: New test. * testsuite/libgomp.fortran/allocate-1.f90: New test. --- gcc/fortran/dump-parse-tree.c | 1 + gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 148 +++++++- gcc/fortran/trans-openmp.c | 87 +++++ gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 137 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 45 +++ gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 | 14 + gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 | 272 +++++++------- gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +- .../gfortran.dg/gomp/openmp-simd-4.f90 | 6 +- .../testsuite/libgomp.fortran/allocate-1.c | 7 + .../testsuite/libgomp.fortran/allocate-1.f90 | 333 ++++++++++++++++++ 12 files changed, 896 insertions(+), 157 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 04660d5074a..038c0340cbb 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break; case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1846ee4fd3c..0ef05067850 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1391,6 +1391,7 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, + OMP_LIST_ALLOCATE, OMP_LIST_NUM }; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index d120be81467..b4d7bb814eb 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -912,6 +912,7 @@ enum omp_mask1 OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */ OMP_CLAUSE_BIND, /* OpenMP 5.0. */ OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ OMP_CLAUSE_AT, /* OpenMP 5.1. */ @@ -1541,6 +1542,41 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_ALLOCATE) + && gfc_match ("allocate ( ") == MATCH_YES) + { + gfc_expr *allocator = NULL; + old_loc = gfc_current_locus; + m = gfc_match_expr (&allocator); + if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) + { + /* If no ":" then there is no allocator, we backtrack + and read the variable list. */ + gfc_free_expr (allocator); + allocator = NULL; + gfc_current_locus = old_loc; + } + + gfc_omp_namelist **head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], + true, NULL, &head); + + if (m != MATCH_YES) + { + gfc_free_expr (allocator); + gfc_error ("Expected variable list at %C"); + goto error; + } + + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + if (allocator) + n->expr = gfc_copy_expr (allocator); + else + n->expr = NULL; + gfc_free_expr (allocator); + continue; + } if ((mask & OMP_CLAUSE_AT) && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) != MATCH_NO) @@ -3523,7 +3559,7 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PROC_BIND) + | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE) #define OMP_DECLARE_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ @@ -3532,15 +3568,16 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + #define OMP_SCOPE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ @@ -3551,20 +3588,22 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \ - | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE) +#define OMP_TASKGROUP_CLAUSES \ + (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_THREAD_LIMIT) + | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -3580,13 +3619,14 @@ cleanup: #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ - | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_SINGLE_CLAUSES \ - (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_ALLOCATE) #define OMP_ORDERED_CLAUSES \ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ @@ -5849,7 +5889,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); + return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES); } @@ -6187,7 +6227,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", "ALLOCATE" }; STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); if (omp_clauses == NULL) @@ -6473,7 +6513,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && list != OMP_LIST_REDUCTION_INSCAN && list != OMP_LIST_REDUCTION_TASK && list != OMP_LIST_IN_REDUCTION - && list != OMP_LIST_TASK_REDUCTION) + && list != OMP_LIST_TASK_REDUCTION + && list != OMP_LIST_ALLOCATE) for (n = omp_clauses->lists[list]; n; n = n->next) { bool component_ref_p = false; @@ -6542,6 +6583,78 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->expr && (n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "'omp_allocator_handle_kind' kind at %L", + &n->expr->where); + break; + } + + /* Check for 2 things here. + 1. There is no duplication of variable in allocate clause. + 2. Variable in allocate clause are also present in some + privatization clase (non-composite case). */ + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + n->sym->mark = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) + { + if (n->sym->mark == 1) + { + gfc_warning (0, "%qs appears more than once in %<allocate%> " + "clauses at %L" , n->sym->name, &n->where); + /* We have already seen this variable so it is a duplicate. + Remove it. */ + if (prev != NULL && prev->next == n) + { + prev->next = n->next; + n->next = NULL; + gfc_free_omp_namelist (n, 0); + n = prev->next; + } + continue; + } + n->sym->mark = 1; + prev = n; + n = n->next; + } + + /* non-composite constructs. */ + if (code && code->op < EXEC_OMP_DO_SIMD) + { + for (list = 0; list < OMP_LIST_NUM; list++) + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: + case OMP_LIST_REDUCTION_TASK: + case OMP_LIST_IN_REDUCTION: + case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_LINEAR: + for (n = omp_clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->mark == 1) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", + n->sym->name, &n->where); + } + } + /* OpenACC reductions. */ if (openacc) { @@ -8259,19 +8372,20 @@ resolve_omp_do (gfc_code *code) if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) if (!is_simd || code->ext.omp_clauses->collapse > 1 - ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE) : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_LINEAR)) + && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { if (!is_simd || code->ext.omp_clauses->collapse > 1) gfc_error ("%s iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - name, &do_code->loc); + "other than PRIVATE, LASTPRIVATE or " + "ALLOCATE at %L", name, &do_code->loc); else gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE or " + "other than PRIVATE, LASTPRIVATE, ALLOCATE or " "LINEAR at %L", name, &do_code->loc); break; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 5b3c310ba59..d6293513fd5 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2646,6 +2646,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATE: + 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_ALLOCATE); + OMP_CLAUSE_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_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -6140,6 +6162,71 @@ gfc_split_omp_clauses (gfc_code *code, == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) && !is_loop) clausesa[GFC_OMP_SPLIT_DO].nowait = true; + + /* Distribute allocate clause to do, parallel, distribute, teams, target + and taskloop. The code below itereates over variables in the + allocate list and checks if that available is also in any + privatization clause on those construct. If yes, then we add it + to the list of 'allocate'ed variables for that construct. If a + variable is found in none of them then we issue an error. */ + + if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + gfc_omp_namelist *alloc_nl, *priv_nl; + gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM]; + for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; + alloc_nl; alloc_nl = alloc_nl->next) + { + bool found = false; + for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++) + { + gfc_omp_namelist *p; + int list; + for (list = 0; list < OMP_LIST_NUM; list++) + { + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: + case OMP_LIST_REDUCTION_TASK: + case OMP_LIST_IN_REDUCTION: + case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_LINEAR: + for (priv_nl = clausesa[i].lists[list]; priv_nl; + priv_nl = priv_nl->next) + if (alloc_nl->sym == priv_nl->sym) + { + found = true; + p = gfc_get_omp_namelist (); + p->sym = alloc_nl->sym; + p->expr = alloc_nl->expr; + p->where = alloc_nl->where; + if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL) + { + clausesa[i].lists[OMP_LIST_ALLOCATE] = p; + tails[i] = p; + } + else + { + tails[i]->next = p; + tails[i] = tails[i]->next; + } + } + break; + default: + break; + } + } + } + if (!found) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", alloc_nl->sym->name, + &alloc_nl->where); + } + } } static tree diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 new file mode 100644 index 00000000000..8bc6b768778 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 @@ -0,0 +1,137 @@ +! { 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 bar (a, b, c) + implicit none + integer :: a + integer :: b + integer :: c + c = a + b +end + +subroutine bar2 (a, b, c) + implicit none + integer :: a + integer :: b(15) + integer :: c + c = a + b(1) +end + +subroutine foo(x, y) + use omp_lib_kinds + implicit none + integer :: x + integer :: z + + integer, dimension(15) :: y + integer :: r + integer :: i + integer c1, c2, c3, c4 + integer (kind=omp_allocator_handle_kind) :: h + common /B1/ c1, c2 + common /B2/ c3, c4 + + r = 0 + h = omp_default_mem_alloc; + + + !$omp parallel private(/B1/, c3, c4) allocate(/B1/, /B2/) + !$omp end parallel + + !$omp parallel private(/B1/, /B2/) allocate(h:/B1/, /B2/) + !$omp end parallel + + !$omp parallel private(/B1/, /B2/) allocate(omp_large_cap_mem_alloc:/B1/, c3, c4) + !$omp end parallel + + !$omp parallel allocate (x) allocate (h : y) & + !$omp allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z) + call bar2 (x, y, z); + !$omp end parallel + + !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z) + call bar (0, x, z); + !$omp end task + + !$omp target teams distribute parallel do private (x) firstprivate (y) & + !$omp allocate ((omp_default_mem_alloc + 0):z) allocate & + !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r) + do i = 1, 10 + call bar (0, x, z); + call bar2 (1, y, r); + end do + !$omp end target teams distribute parallel do + + !$omp single private (x) allocate (omp_low_lat_mem_alloc:x) + x=1 + !$omp end single + + !$omp single allocate (omp_low_lat_mem_alloc:x) private (x) + !$omp end single + + !$omp parallel + !$omp do allocate (x) private (x) + do i = 1, 64 + x = 1; + end do + !$omp end parallel + + !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x) + x = 1; + !$omp section + x = 2; + !$omp section + x = 3; + !$omp end sections + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + call bar (r, r, r); + !$omp end taskgroup + + !$omp teams private (x) firstprivate (y) allocate (h : x, y) + call bar2 (x, y, r); + !$omp end teams + + !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r) + do i = 1, 16 + call bar (0, r, r); + x = i; + end do + !$omp end taskloop + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + !$omp taskloop firstprivate (x) in_reduction (+:r) & + !$omp allocate (omp_default_mem_alloc : x, r) + do i = 1, 16 + call bar (x, r, r); + end do + !$omp end taskloop + !$omp end taskgroup + !$omp taskwait +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 new file mode 100644 index 00000000000..88b2d26872d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 @@ -0,0 +1,45 @@ +! { 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 + +end module + +subroutine foo(x) + use omp_lib_kinds + implicit none + integer :: x + + !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=1 + !$omp end task + + !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=2 + !$omp end parallel + + !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=3 + !$omp end parallel + + !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=4 + !$omp end parallel + + !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=5 + !$omp end parallel + + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=6 + !$omp end parallel + + !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=7 + !$omp end parallel + +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 new file mode 100644 index 00000000000..7b57be980cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } + +subroutine foo(x) + implicit none + integer :: x + integer :: i + + !$omp parallel do simd private (x) allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + do i = 1, 64 + x = i + end do + !$omp end parallel do simd + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 index 639f5d19bdb..92801852984 100644 --- a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 @@ -36,8 +36,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -46,8 +46,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -55,8 +55,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute simd & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -81,8 +81,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) copyin(t) - ! FIXME/TODO: allocate (p) + !$omp& lastprivate (l) schedule(static, 4) copyin(t) & + !$omp& allocate (p) do i = 1, 64 ll = ll +1 end do @@ -90,8 +90,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (p) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (p) do i = 1, 64 ll = ll +1 end do @@ -100,8 +100,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -110,8 +110,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -119,8 +119,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute simd & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -140,8 +140,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp do simd & !$omp& private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -149,16 +149,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel do & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp parallel do & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -166,16 +166,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel do simd & !$omp& private (p) firstprivate (f) if (i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp parallel sections & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) & + !$omp& allocate (f) !$omp section block; end block !$omp section @@ -185,16 +185,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target parallel & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& depend(inout: dd(0)) in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& depend(inout: dd(0)) in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) !$omp end target parallel nowait !$omp target parallel do & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) depend(inout: dd(0)) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -204,8 +204,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) depend(inout: dd(0)) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -216,8 +216,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -226,15 +226,15 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte - 1:nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) !$omp end target teams nowait !$omp target teams distribute & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) order(concurrent) & - !$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 end do !$omp end target teams distribute nowait @@ -245,8 +245,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) depend(inout: dd(0)) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -259,8 +259,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -271,8 +271,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -282,34 +282,34 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& safelen(8) simdlen(4) lastprivate (l) linear(ll: 1) aligned(q: 32) reduction(+:r) & !$omp& depend(inout: dd(0)) nontemporal(ntm) if(simd:i3) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do !$omp end target simd nowait - !$omp taskgroup task_reduction(+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction(+:r2) & + !$omp& allocate (r2) !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp end taskgroup - !$omp taskgroup task_reduction(+:r) - ! FIXME/TODO: allocate (r) + !$omp taskgroup task_reduction(+:r) & + !$omp& allocate (r) !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(i1) & !$omp& final(fi) mergeable nogroup priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) in_reduction(+:r) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -319,8 +319,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) if(taskloop: i1) & !$omp& final(fi) priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(+:r) if (simd: i3) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -328,8 +328,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target depend(inout: dd(0)) in_reduction(+:r2) !$omp teams distribute & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & - !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 end do !$omp end target nowait @@ -339,8 +339,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -352,8 +352,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -363,8 +363,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp teams distribute simd & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -374,8 +374,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& lastprivate (l) schedule(static, 4) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -384,8 +384,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) - ! FIXME/TODO: allocate (f) + !$omp& lastprivate (l) schedule(static, 4) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -395,8 +395,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -406,8 +406,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -415,68 +415,68 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp teams distribute simd & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) - ! FIXME/TODO: allocate(f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) & + !$omp& allocate(f) do i = 1, 64 ll = ll +1 end do !$omp parallel master & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) !$omp end parallel master !$omp parallel masked & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) & + !$omp& allocate (f) !$omp end parallel masked - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) in_reduction(+:r2) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) in_reduction(+:r2) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & - !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -485,8 +485,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -494,8 +494,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -504,8 +504,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -514,14 +514,14 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) & !$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) @@ -530,8 +530,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) & !$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) @@ -540,25 +540,25 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) & !$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -566,8 +566,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & - !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -575,8 +575,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) & - !$omp& copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& copyin(t) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -584,8 +584,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -593,8 +593,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) & !$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -607,31 +607,31 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel loop & !$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) & + !$omp& allocate (f) do l = 1, 64 ll = ll + 1 end do !$omp parallel loop & !$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) & + !$omp& allocate (f) do l = 1, 64 ll = ll + 1 end do !$omp teams loop & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & - !$omp& collapse(1) lastprivate (l) bind(teams) - ! FIXME/TODO: allocate (f) + !$omp& collapse(1) lastprivate (l) bind(teams) & + !$omp& allocate (f) do l = 1, 64 end do !$omp teams loop & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & - !$omp& collapse(1) lastprivate (l) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& collapse(1) lastprivate (l) order(concurrent) & + !$omp& allocate (f) do l = 1, 64 end do @@ -639,8 +639,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& depend(inout: dd(0)) lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) & - !$omp& if (target: i1) if (parallel: i2) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& if (target: i1) if (parallel: i2) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target parallel loop nowait @@ -648,8 +648,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams loop & !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target teams loop nowait @@ -657,8 +657,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams loop & !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target teams loop nowait diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index 1a06eaba823..01cfc82b760 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -24,7 +24,7 @@ subroutine collapse1 end do !$omp parallel do collapse(2) shared(j) do i = 1, 3 - do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" } + do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } end do end do !$omp parallel do collapse(2) diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 index 4a17fb9820e..17375e0eff5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 @@ -45,17 +45,17 @@ do i = 1, 5 end do !$omp parallel do firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } x(i) = 42 end do !$omp parallel do simd firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" } +do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" } x(i) = 42 end do !$omp simd linear(i) collapse(2) -do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } do j = 1, 2 y(j, i) = 52 end do 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-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 new file mode 100644 index 00000000000..35d1750b878 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -0,0 +1,333 @@ +! { 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, p, q, px, h, fl) + use omp_lib + use iso_c_binding + integer :: x + integer, dimension(4) :: p + integer, dimension(4) :: q + integer :: px + integer (kind=omp_allocator_handle_kind) :: h + integer :: fl + + integer :: y + integer :: r, i, i1, i2, i3, i4, i5 + integer :: l, l3, l4, l5, l6 + integer :: n, n1, n2, n3, n4 + integer :: j2, j3, j4 + integer, dimension(4) :: l2 + integer, dimension(4) :: r2 + integer, target :: xo + integer, target :: yo + integer, dimension(x) :: v + integer, dimension(x) :: w + + type s_type + integer :: a + integer :: b + end type + + type (s_type) :: s + s%a = 27 + s%b = 29 + y = 0 + r = 0 + n = 8 + n2 = 9 + n3 = 10 + n4 = 11 + xo = x + yo = y + + do i = 1, 4 + r2(i) = 0; + end do + + do i = 1, 4 + p(i) = 0; + end do + + do i = 1, 4 + q(i) = 0; + end do + + do i = 1, x + w(i) = i + end do + + !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) + if (x /= 42) then + stop 1 + end if + v(1) = 7 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(v(1)) == 0))) then + stop 2 + end if + + !$omp barrier + y = 1; + x = x + 1 + v(1) = 7 + v(41) = 8 + !$omp barrier + if (x /= 43 .or. y /= 1) then + stop 3 + end if + if (v(1) /= 7 .or. v(41) /= 8) then + stop 4 + end if + !$omp end parallel + + !$omp teams + !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) + + if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then + stop 5 + end if + !$omp barrier + y = 1; + x = x + 1 + w(19) = w(19) + 1 + !$omp barrier + if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then + stop 6 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(w(1)) == 0))) then + stop 7 + end if + !$omp end parallel + !$omp end teams + + !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) + do i = 0, 63 + if (x /= 42) then + stop 8 + end if + y = 1; + l = i; + n = n + y + 15; + r = r + i; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(r) == 0) .or. & + (is_64bit_aligned(l) == 0) .or. & + (is_64bit_aligned(n) == 0))) then + stop 9 + end if + end do + !$omp end parallel do + + !$omp parallel + !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3) + do i1 = 0, 63 + l2(1) = i1 + l2(2) = i1 + 1 + l2(3) = i1 + 2 + l2(4) = i1 + 3 + if (i1 < 37) then + l3 = i1 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l2(1)) == 0) .or. & + (is_64bit_aligned(l3) == 0) .or. & + (is_64bit_aligned(i1) == 0))) then + stop 10 + end if + end do + + !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) + do i2 = 3, 4 + do j2 = 17, 22, 2 + n2 = n2 + 17 + l4 = i2 * 31 + j2 + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l4) == 0) .or. & + (is_64bit_aligned(n2) == 0) .or. & + (is_64bit_aligned(i2) == 0) .or. & + (is_64bit_aligned(j2) == 0))) then + stop 11 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) + do i3 = 3, 4 + do j3 = 17, 22, 2 + n3 = n3 + 17 + l5 = i3 * 31 + j3 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(l5) == 0) .or. & + (is_64bit_aligned(n3) == 0) .or. & + (is_64bit_aligned(i3) == 0) .or. & + (is_64bit_aligned(j3) == 0))) then + stop 12 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) + do i4 = 3, 4 + do j4 = 17, 22,2 + n4 = n4 + 17; + l6 = i4 * 31 + j4; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l6) == 0) .or. & + (is_64bit_aligned(n4) == 0) .or. & + (is_64bit_aligned(i4) == 0) .or. & + (is_64bit_aligned(j4) == 0))) then + stop 13 + end if + end do + end do + + !$omp do lastprivate (i5) allocate (i5) + do i5 = 1, 17, 3 + if ( (and(fl, 2) /= 0) .and. & + (is_64bit_aligned(i5) == 0)) then + stop 14 + end if + end do + + !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) + do i = 0, 31 + p(3) = p(3) + i; + p(4) = p(4) + (2 * i) + q(1) = q(1) + (3 * i) + q(3) = q(3) + (4 * i) + r2(1) = r2(1) + (5 * i) + r2(4) = r2(4) + (6 * i) + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(q(1)) == 0) .or. & + (is_64bit_aligned(p(1)) == 0) .or. & + (is_64bit_aligned(r2(1)) == 0) )) then + stop 15 + end if + end do + + !$omp task private(y) firstprivate(x) allocate(x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(x) allocate(h: x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(h: s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp end parallel + + if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then + stop 20 + end if + + if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then + stop 21 + end if + + if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then + stop 22 + end if + + if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then + stop 23 + end if + + if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then + stop 24 + end if + + if (i5 /= 19) then + stop 24 + end if + + if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) & + .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) & + .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then + stop 25 + end if + +end subroutine + +program main + use omp_lib + integer, dimension(4) :: p + integer, dimension(4) :: q + + 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, p, q, 2, a, 0); + call foo (42, p, q, 2, omp_default_mem_alloc, 0); + call foo (42, p, q, 2, a, 1); + call omp_set_default_allocator (a); + call foo (42, p, q, 2, omp_null_allocator, 3); + call foo (42, p, q, 2, omp_default_mem_alloc, 2); + call omp_destroy_allocator (a); +end -- 2.25.1