From patchwork Fri Oct 22 13:05:02 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 46529 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 09142385781C for ; Fri, 22 Oct 2021 13:05:43 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id E0E2A3858416 for ; Fri, 22 Oct 2021 13:05:22 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E0E2A3858416 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: oYeb/D12O7yIplt/FUO0CM3XBpbSJOvNi7wV8fm8SM70PUlhOJKTjuNDSx5hExdE6uoyu9xSgN dwYgZ2VjiRxjkXV5tkciwEeRwVznravpuQl1XACmK6W83J2dF+pDMQDtGvCu+aG5kv1gvvOW1G cv+IQd/NzxHEEbMeCDBx52ks7YBpc3X7B2QOvwWV6M8lhOEkvwMtN3oXaB02orsSC5zMlNhte8 os67u9YB2CwmvsFOWyIcU/LMTh3RNM3Kta02s3+eoOt1so/TFSNBKi4e7/asBmK+Htn12qs4I6 kLOZ0QPwqYxNk0rPjqVeV93k X-IronPort-AV: E=Sophos;i="5.87,172,1631606400"; d="scan'208";a="67375475" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 22 Oct 2021 05:05:22 -0800 IronPort-SDR: ByK7nX8x0tLyYha5Enx0sH6wN0ZgnOU7v7zO0etx2Belg10hMoJMUeKiP8La5sh6dIbdPWiClf eO7KL7n3CzUMPcPKn7g8y5n2yzzoNG5zOADhMjWRsXwbMkxURAUQ6DgPO6AWIeFnWxB7vWXWVs TXYr4egUc2vpf00bsKjbvsepjpvnMGcywtRB16Bmskx7gJr8BYbeDm8K0lwWkjcL5vS/YgRnwS /P4In8VRryKEbci5PvP+jXLN7FWTm+VlPCARRM1QVFODShSxuAbsyr3tIi0TmmpDp+LgRoQFZX UNM= From: Hafiz Abid Qadeer To: Subject: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). Date: Fri, 22 Oct 2021 14:05:02 +0100 Message-ID: <20211022130502.2211568-1-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-02.mgc.mentorg.com (139.181.222.2) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-12.2 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SCC_5_SHORT_WORD_LINES, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: jakub@redhat.com, tobias@codesourcery.com, abidh@codesourcery.com Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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. (allocate): New member in gfc_symbol. * 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/collapse1.f90: Update error message. * gfortran.dg/gomp/openmp-simd-4.f90: Likewise. 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 | 5 + gcc/fortran/openmp.c | 140 +++++++- gcc/fortran/trans-openmp.c | 34 ++ gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 123 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 45 +++ 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 ++++++++++++++++++ 10 files changed, 675 insertions(+), 21 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 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 14a307856fc..66af802ec36 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 66192c07d8c..feae00052cc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1388,6 +1388,7 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, + OMP_LIST_ALLOCATE, OMP_LIST_NUM }; @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol according to the Fortran standard. */ unsigned pass_as_value:1; + /* Used to check if a variable used in allocate clause has also been + used in privatization clause. */ + unsigned allocate:1; + int refs; struct gfc_namespace *ns; /* namespace containing this symbol */ diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dcf22ac2c2f..aac8d2580a4 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -911,6 +911,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. */ @@ -1540,6 +1541,40 @@ 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_error ("Expected allocator or variable list at %C"); + goto error; + } + if (gfc_match (" : ") != MATCH_YES) + { + /* If no ":" then there is no allocator, we backtrack + and read the variable list. */ + allocator = NULL; + gfc_current_locus = old_loc; + } + + gfc_omp_namelist **head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], + false, NULL, &head); + + if (m == MATCH_ERROR) + break; + + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + if (allocator) + n->expr = gfc_copy_expr (allocator); + else + n->expr = NULL; + continue; + } if ((mask & OMP_CLAUSE_AT) && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) != MATCH_NO) @@ -3511,7 +3546,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 \ @@ -3520,15 +3555,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 \ @@ -3539,19 +3575,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_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ + | 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) @@ -3567,13 +3606,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 \ @@ -5836,7 +5876,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); } @@ -6174,7 +6214,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) @@ -6457,7 +6497,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; @@ -6526,6 +6567,70 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + 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. */ + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + n->sym->allocate = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) + { + if (n->sym->allocate == 1) + { + gfc_warning (0, "%qs appears more than once in % " + "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->allocate = 1; + prev = n; + n = n->next; + } + + 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->allocate = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->allocate == 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) { @@ -8233,19 +8338,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 e81c5588c53..cce65f999cb 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 || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + 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; @@ -5857,6 +5879,8 @@ gfc_split_omp_clauses (gfc_code *code, /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR] = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR]; clausesa[GFC_OMP_SPLIT_TARGET].device @@ -5883,6 +5907,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing = code->ext.omp_clauses->default_sharing; + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_DISTRIBUTE) { @@ -5900,6 +5926,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_unconstrained; clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible = code->ext.omp_clauses->order_reproducible; + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_PARALLEL) { @@ -5921,6 +5949,8 @@ gfc_split_omp_clauses (gfc_code *code, /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr = code->ext.omp_clauses->if_expr; + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_MASKED) clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter; @@ -5958,6 +5988,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_unconstrained; clausesa[GFC_OMP_SPLIT_DO].order_reproducible = code->ext.omp_clauses->order_reproducible; + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_SIMD) { @@ -6005,6 +6037,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->mergeable; clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP] = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP]; + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr = code->ext.omp_clauses->if_expr; 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..34dad47a39d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 @@ -0,0 +1,123 @@ +! { 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 (kind=omp_allocator_handle_kind) :: h + r = 0 + h = omp_default_mem_alloc; + + !$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/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 + +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