From patchwork Thu Jan 13 14:53:16 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 49970 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 DB68D3951C04 for ; Thu, 13 Jan 2022 14:54:37 +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 248B039518B1; Thu, 13 Jan 2022 14:53:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 248B039518B1 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: vPE3/sjiNS5YazNALR6PXOM23++h9y5MhnhuJPQGImcDvFacusYxgaVun7iWnTIElbermJol0L q14aJHAnGe4EiH9t9whtwnk9TFJilad0jw+Y1hg3QF4M1MHXqaYx+UtGvqGzHDuuEzqj0UWL9P pA1AYOsIJTOEttS49SkaFf8T48Ngvy3hl+K9USKyhukb8FNwcg9NHfVTtPePEkrKnDJGK/iIVL nAPprKa7oytTiFFYUMTAAh9CymX2D5vznmELuccNlNTQT+lxqa3mohn8rt48c9oySuNIWXWjF2 Fk+ZicrFWzhewO8WZT+RsLet X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70595074" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:53:33 -0800 IronPort-SDR: vRnE+pfV/kbs+un2VQ543P8bHIJfqIMBp/GO2NZVGr6AuaklB8hZVqF/CX+9xibf3R3gIfSXQD O++GbHFytjKKEoev7/9zukkpMaqhmcr1gIyzsGMvWuPtTW/McIAGeQDoX06zgrHTEUZBggESBC sifF52OLHbYHjNaf/bxefOPzRZBE3RPzFDuW8mulvAsCBfSkwTCGcesdJvZMjIMelgFEITLIOL mMk4AY5XaiQo+DnXtXS+bheuNSo0Vlv9A91uyeTlWyrCS74WMiiNLycg/z6kMacFAvYlR/3UaW kpU= From: Hafiz Abid Qadeer To: , Subject: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:16 +0000 Message-ID: <20220113145320.3153087-2-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113145320.3153087-1-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, 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 Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Currently we only make use of this directive when it is associated with an allocate statement. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_ALLOCATE. (show_code_node): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE. (OMP_LIST_ALLOCATOR): New enum value. (enum gfc_exec_op): Add EXEC_OMP_ALLOCATE. * match.h (gfc_match_omp_allocate): New function. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR. (OMP_ALLOCATE_CLAUSES): New define. (gfc_match_omp_allocate): New function. (resolve_omp_clauses): Add ALLOCATOR in clause_names. (omp_code_to_statement): Handle EXEC_OMP_ALLOCATE. (EMPTY_VAR_LIST): New define. (check_allocate_directive_restrictions): New function. (gfc_resolve_omp_allocate): Likewise. (gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE. * parse.c (decode_omp_directive): Handle ST_OMP_ALLOCATE. (next_statement): Likewise. (gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE. * st.c (gfc_free_statement): Likewise. * trans.c (trans_code): Likewise gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-4.f90: New test. * gfortran.dg/gomp/allocate-5.f90: New test. --- gcc/fortran/dump-parse-tree.c | 3 + gcc/fortran/gfortran.h | 4 +- gcc/fortran/match.h | 1 + gcc/fortran/openmp.c | 199 +++++++++++++++++- gcc/fortran/parse.c | 10 +- gcc/fortran/resolve.c | 1 + gcc/fortran/st.c | 1 + gcc/fortran/trans.c | 1 + gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 112 ++++++++++ gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 73 +++++++ 10 files changed, 400 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 7459f4b89a9..38fef42150a 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1993,6 +1993,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break; case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break; + case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break; case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; case EXEC_OMP_CANCEL: name = "CANCEL"; break; @@ -2194,6 +2195,7 @@ show_omp_node (int level, gfc_code *c) || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN || c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR + || c->op == EXEC_OMP_ALLOCATE || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -3314,6 +3316,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OMP_ALLOCATE: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3b791a4f6be..79a43a2fdf0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -259,7 +259,7 @@ enum gfc_statement ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP, ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL, ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE, - ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, + ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, ST_OMP_ALLOCATE, ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC, ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS, @@ -1392,6 +1392,7 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, + OMP_LIST_ALLOCATOR, OMP_LIST_NUM }; @@ -2893,6 +2894,7 @@ enum gfc_exec_op EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE, + EXEC_OMP_ALLOCATE, EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO, EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE, diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 65ee3b6cb41..9f0449eda0e 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -149,6 +149,7 @@ match gfc_match_oacc_routine (void); /* OpenMP directive matchers. */ match gfc_match_omp_eos_error (void); +match gfc_match_omp_allocate (void); match gfc_match_omp_atomic (void); match gfc_match_omp_barrier (void); match gfc_match_omp_cancel (void); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 86c412a4334..ee7c39980bb 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -921,6 +921,7 @@ enum omp_mask1 OMP_CLAUSE_FAIL, /* OpenMP 5.1. */ OMP_CLAUSE_WEAK, /* OpenMP 5.1. */ OMP_CLAUSE_NOWAIT, + OMP_CLAUSE_ALLOCATOR, /* This must come last. */ OMP_MASK1_LAST }; @@ -3568,6 +3569,7 @@ cleanup: } +#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR)) #define OMP_PARALLEL_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ @@ -5762,6 +5764,64 @@ gfc_match_omp_ordered_depend (void) return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND)); } +/* omp allocate (list) [clause-list] + - clause-list: allocator +*/ + +match +gfc_match_omp_allocate (void) +{ + gfc_omp_clauses *c = gfc_get_omp_clauses (); + gfc_expr *allocator = NULL; + match m; + + m = gfc_match (" ("); + if (m == MATCH_YES) + { + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR], + true, NULL); + + if (m != MATCH_YES) + { + /* If the list was empty, we must find closing ')'. */ + m = gfc_match (")"); + if (m != MATCH_YES) + return m; + } + } + + if (gfc_match (" allocator ( ") == MATCH_YES) + { + m = gfc_match_expr (&allocator); + if (m != MATCH_YES) + { + gfc_error ("Expected allocator at %C"); + return MATCH_ERROR; + } + if (gfc_match (" ) ") != MATCH_YES) + { + gfc_error ("Expected ')' at %C"); + gfc_free_expr (allocator); + return MATCH_ERROR; + } + } + + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_free_expr (allocator); + gfc_error ("Unexpected junk after $OMP allocate at %C"); + return MATCH_ERROR; + } + gfc_omp_namelist *n; + for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next) + n->expr = gfc_copy_expr (allocator); + + new_st.op = EXEC_OMP_ALLOCATE; + new_st.ext.omp_clauses = c; + gfc_free_expr (allocator); + return MATCH_YES; +} + /* omp atomic [clause-list] - atomic-clause: read | write | update @@ -6243,7 +6303,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", - "NONTEMPORAL" }; + "NONTEMPORAL", "ALLOCATOR" }; STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); if (omp_clauses == NULL) @@ -8507,6 +8567,8 @@ omp_code_to_statement (gfc_code *code) { switch (code->op) { + case EXEC_OMP_ALLOCATE: + return ST_OMP_ALLOCATE; case EXEC_OMP_PARALLEL: return ST_OMP_PARALLEL; case EXEC_OMP_PARALLEL_MASKED: @@ -8987,6 +9049,138 @@ gfc_resolve_oacc_routines (gfc_namespace *ns) } } +static void +check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al, + gfc_namespace *ns, locus loc) +{ + if (sym->attr.save != SAVE_NONE || sym->attr.in_common == 1 + || sym->module != NULL) + { + int tmp; + /* Assumption here is that we can extract an integer then + it is a predefined thing. */ + if (!omp_al || gfc_extract_int (omp_al, &tmp)) + gfc_error ("%qs should use predefined allocator at %L", sym->name, + &loc); + } + if (ns != sym->ns) + gfc_error ("%qs is not in the same scope as %" + " directive at %L", sym->name, &loc); +} + +#define EMPTY_VAR_LIST(node) \ + (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL) + +static void +gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns) +{ + gfc_alloc *al; + gfc_omp_namelist *n = NULL; + gfc_omp_namelist *cn = NULL; + gfc_omp_namelist *p, *tail; + gfc_code *cur; + hash_set vars; + + gfc_omp_clauses *clauses = code->ext.omp_clauses; + gcc_assert (clauses); + cn = clauses->lists[OMP_LIST_ALLOCATOR]; + gfc_expr *omp_al = cn ? cn->expr : NULL; + + if (omp_al && (omp_al->ts.type != BT_INTEGER + || omp_al->ts.kind != gfc_c_intptr_kind)) + gfc_error ("Expected integer expression of the " + "% kind at %L", &omp_al->where); + + /* Check that variables in this allocate directive are not duplicated + in this directive or others coming directly after it. */ + for (cur = code; cur != NULL && cur->op == EXEC_OMP_ALLOCATE; + cur = cur->next) + { + gfc_omp_clauses *c = cur->ext.omp_clauses; + gcc_assert (c); + for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next) + { + if (vars.contains (n->sym)) + gfc_error ("%qs is used in multiple % " + "directives at %L", n->sym->name, &cur->loc); + /* This helps us avoid duplicate error messages. */ + if (cur == code) + vars.add (n->sym); + } + } + + if (cur == NULL || cur->op != EXEC_ALLOCATE) + { + /* There is no allocate statement right after allocate directive. + We don't support this case at the moment. */ + for (n = cn; n != NULL; n = n->next) + { + gfc_symbol *sym = n->sym; + if (sym->attr.allocatable == 1) + gfc_error ("%qs with ALLOCATABLE attribute is not allowed in " + "% directive at %L as this directive is not" + " associated with an % statement.", + sym->name, &code->loc); + } + sorry_at (code->loc.lb->location, "% directive that is " + "not associated with an % statement is not " + "supported."); + return; + } + + /* If there is another allocate directive right after this one, check + that none of them is empty. Doing it this way, we can check this + thing even when multiple directives are together and generate + error at right location. */ + if (code->next && code->next->op == EXEC_OMP_ALLOCATE + && (EMPTY_VAR_LIST (code) || EMPTY_VAR_LIST (code->next))) + gfc_error ("Empty variable list is not allowed at %L when multiple " + "% directives are associated with an " + "% statement.", + EMPTY_VAR_LIST (code) ? &code->loc : &code->next->loc); + + if (EMPTY_VAR_LIST (code)) + { + /* Empty namelist means allocate directive applies to all + variables in allocate statement. 'cur' points to associated + allocate statement. */ + for (al = cur->ext.alloc.list; al != NULL; al = al->next) + if (al->expr && al->expr->symtree && al->expr->symtree->n.sym) + { + check_allocate_directive_restrictions (al->expr->symtree->n.sym, + omp_al, ns, code->loc); + p = gfc_get_omp_namelist (); + p->sym = al->expr->symtree->n.sym; + p->expr = omp_al; + p->where = code->loc; + if (cn == NULL) + cn = tail = p; + else + { + tail->next = p; + tail = tail->next; + } + } + clauses->lists[OMP_LIST_ALLOCATOR]= cn; + } + else + { + for (n = cn; n != NULL; n = n->next) + { + for (al = cur->ext.alloc.list; al != NULL; al = al->next) + if (al->expr && al->expr->symtree && al->expr->symtree->n.sym + && al->expr->symtree->n.sym == n->sym) + break; + if (al == NULL) + gfc_error ("%qs in % directive at %L is not present " + "in associated % statement.", + n->sym->name, &code->loc); + check_allocate_directive_restrictions (n->sym, omp_al, ns, + code->loc); + } + } +} + void gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) @@ -9128,6 +9322,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) code->ext.omp_clauses->if_present = false; resolve_omp_clauses (code, code->ext.omp_clauses, ns); break; + case EXEC_OMP_ALLOCATE: + gfc_resolve_omp_allocate (code, ns); + break; default: break; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c04ad774f25..fda36433129 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -886,6 +886,7 @@ decode_omp_directive (void) { case 'a': matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); + matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE); break; case 'b': matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); @@ -1672,9 +1673,9 @@ next_statement (void) case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \ case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \ - case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \ - case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ - case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ + case ST_OMP_ALLOCATE: case ST_ERROR_STOP: case ST_OMP_SCAN: \ + case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: \ + case ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ case ST_END_TEAM: case ST_SYNC_TEAM: \ case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \ case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ @@ -2351,6 +2352,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OACC_END_ATOMIC: p = "!$ACC END ATOMIC"; break; + case ST_OMP_ALLOCATE: + p = "!$OMP ALLOCATE"; + break; case ST_OMP_ATOMIC: p = "!$OMP ATOMIC"; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 43eeefee07f..991cd4fe874 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12306,6 +12306,7 @@ start: gfc_resolve_oacc_directive (code, ns); break; + case EXEC_OMP_ALLOCATE: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CANCEL: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 73f30c2137f..7b282e96c3d 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OMP_ALLOCATE: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 26f0815b5ea..a2248c83623 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2140,6 +2140,7 @@ trans_code (gfc_code * code, tree cond) res = gfc_trans_dt_end (code); break; + case EXEC_OMP_ALLOCATE: case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_CANCEL: diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 new file mode 100644 index 00000000000..3f512d66495 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 @@ -0,0 +1,112 @@ +! { dg-do compile } + +module test + integer, allocatable :: mvar1 + integer, allocatable :: mvar2 + integer, allocatable :: mvar3 +end module + +subroutine foo(x, y) + use omp_lib + implicit none + integer :: x + integer :: y + + integer, allocatable :: var1(:) + integer, allocatable :: var2(:) + integer, allocatable :: var3(:) + integer, allocatable :: var4(:) + integer, allocatable :: var5(:) + integer, allocatable :: var6(:) + integer, allocatable :: var7(:) + integer, allocatable :: var8(:) + integer, allocatable :: var9(:) + + !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + allocate (var1(x)) + + !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } + allocate (var3(x)) + + !$omp allocate (x) ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." } + x = 2 + + !$omp allocate (var4) ! { dg-error "'var4' with ALLOCATABLE attribute is not allowed in 'allocate' directive at .1. as this directive is not associated with an 'allocate' statement." } + ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." "" { target *-*-* } .-1 } + y = 2 + + !$omp allocate (var5) + !$omp allocate ! { dg-error "Empty variable list is not allowed at .1. when multiple 'allocate' directives are associated with an 'allocate' statement." } + allocate (var5(x)) + + !$omp allocate (var6) + !$omp allocate (var7) ! { dg-error "'var7' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } + !$omp allocate (var8) ! { dg-error "'var8' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } + allocate (var6(x)) + + !$omp allocate (var9) + !$omp allocate (var9) ! { dg-error "'var9' is used in multiple 'allocate' directives at .1." } + allocate (var9(x)) + +end subroutine + +function outer(a) + IMPLICIT NONE + + integer :: outer, a + integer, allocatable :: var1 + + outer = inner(a) + 5 + return + + contains + + integer function inner(x) + integer :: x + integer, allocatable :: var2 + + !$omp allocate (var1, var2) ! { dg-error "'var1' is not in the same scope as 'allocate' directive at .1." } + allocate (var1, var2) + + inner = x + 10 + return + end function inner + +end function outer + +subroutine bar(s) + use omp_lib + use test + integer :: s + integer, save, allocatable :: svar1 + integer, save, allocatable :: svar2 + integer, save, allocatable :: svar3 + + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a + + traits = [omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 8192)] + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) stop 1 + + !$omp allocate (mvar1) allocator(a) ! { dg-error "'mvar1' should use predefined allocator at .1." } + allocate (mvar1) + + !$omp allocate (mvar2) ! { dg-error "'mvar2' should use predefined allocator at .1." } + allocate (mvar2) + + !$omp allocate (mvar3) allocator(omp_low_lat_mem_alloc) + allocate (mvar3) + + !$omp allocate (svar1) allocator(a) ! { dg-error "'svar1' should use predefined allocator at .1." } + allocate (svar1) + + !$omp allocate (svar2) ! { dg-error "'svar2' should use predefined allocator at .1." } + allocate (svar2) + + !$omp allocate (svar3) allocator(omp_low_lat_mem_alloc) + allocate (svar3) +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 new file mode 100644 index 00000000000..761b6dede28 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 @@ -0,0 +1,73 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module + +subroutine foo(x, y) + use omp_lib_kinds + implicit none + integer :: x + integer :: y + + integer, allocatable :: var1(:) + integer, allocatable :: var2(:) + integer, allocatable :: var3(:) + integer, allocatable :: var4(:,:) + integer, allocatable :: var5(:) + integer, allocatable :: var6(:) + integer, allocatable :: var7(:) + integer, allocatable :: var8(:) + integer, allocatable :: var9(:) + integer, allocatable :: var10(:) + integer, allocatable :: var11(:) + integer, allocatable :: var12(:) + + !$omp allocate (var1) allocator(omp_default_mem_alloc) + allocate (var1(x)) + + !$omp allocate (var2) + allocate (var2(x)) + + !$omp allocate (var3, var4) allocator(omp_large_cap_mem_alloc) + allocate (var3(x),var4(x,y)) + + !$omp allocate() + allocate (var5(x)) + + !$omp allocate + allocate (var6(x)) + + !$omp allocate () allocator(omp_default_mem_alloc) + allocate (var7(x)) + + !$omp allocate allocator(omp_default_mem_alloc) + allocate (var8(x)) + + !$omp allocate (var9) allocator(omp_default_mem_alloc) + !$omp allocate (var10) allocator(omp_large_cap_mem_alloc) + allocate (var9(x), var10(x)) + +end subroutine From patchwork Thu Jan 13 14:53:17 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 49971 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 D25EC3951C8D for ; Thu, 13 Jan 2022 14:55:18 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id E9A2939518B9; Thu, 13 Jan 2022 14:53:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E9A2939518B9 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: uVEb5gu556p6hGN+SxOW+Esb7fFs7utmsR5PB3Mi+wlChlSHu7XfX1V5BAwwlpwLbtfbWTsoJ6 TmKiLfi35Foh48b6nkphJPRP+42LX+wzn0JsVy3Fr+e+SW4W1n1BfIlGgtp2aHMzpHHkhbBXhh vtZYkG7Vk0od6TZaWXSuHWo9lX7ZZPqcrqkGfBvoq5xcb45Bt+qeHEp4GHlnnWGSBTJUaz+uxi 2N1cr+7eEpBDc9AkssXP1CqPc+EaC3wwFpizkF81hgT+0LGaydemHV3deJVkfNYG2JjHEHAHc/ 46VFJJSCMhdY9IN/jXI6z4Rc X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70723178" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:53:45 -0800 IronPort-SDR: Aqqhs3TUt5Xwibez/RzIB+qic2jCWyusrUmt2SS1/Af9iTmMKurR1jhAxCsRjrs54Fye0pb+uo lZw6SspZ2l+hjkbayhjQ+wPN6OQfAcFR28GSR/rMmX9Np9V5HiDMUsbEHJh6p5pXDiWRCxUACA qKCH0O89YFxbSNHlT0adA6Jz70PrSRYbxUO4E37e2c5ShSGN0lTiw8DhfBkt5qT3R6rEngxNY6 aZpZYhgqus+1EBU8Mg0b8vmOxKA3k37EzRbjeegeeWOgVfMPR6zYAkzZkXICvyHdTsf1oOSuqh Ptc= From: Hafiz Abid Qadeer To: , Subject: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:17 +0000 Message-ID: <20220113145320.3153087-3-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113145320.3153087-1-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, 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 Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" gcc/fortran/ChangeLog: * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR. (gfc_trans_omp_allocate): New function. (gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE. gcc/ChangeLog: * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR. (dump_generic_node): Handle OMP_ALLOCATE. * tree.def (OMP_ALLOCATE): New. * tree.h (OMP_ALLOCATE_CLAUSES): Likewise. (OMP_ALLOCATE_DECL): Likewise. (OMP_ALLOCATE_ALLOCATOR): Likewise. * tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-6.f90: New test. --- gcc/fortran/trans-openmp.c | 44 ++++++++++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 72 +++++++++++++++++++ gcc/tree-core.h | 3 + gcc/tree-pretty-print.c | 19 +++++ gcc/tree.c | 1 + gcc/tree.def | 4 ++ gcc/tree.h | 11 +++ 7 files changed, 154 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 9661c77f905..cb389f40370 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2649,6 +2649,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATOR: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced) + { + tree t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALLOCATOR); + OMP_ALLOCATE_DECL (node) = t; + if (n->expr) + { + tree allocator_; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + allocator_ = gfc_evaluate_now (se.expr, block); + OMP_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -4888,6 +4910,26 @@ gfc_trans_omp_atomic (gfc_code *code) return gfc_finish_block (&block); } +static tree +gfc_trans_omp_allocate (gfc_code *code) +{ + stmtblock_t block; + tree stmt; + + gfc_omp_clauses *clauses = code->ext.omp_clauses; + gcc_assert (clauses); + + gfc_start_block (&block); + stmt = make_node (OMP_ALLOCATE); + TREE_TYPE (stmt) = void_type_node; + OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses, + code->loc, false, + true); + gfc_add_expr_to_block (&block, stmt); + gfc_merge_block_scope (&block); + return gfc_finish_block (&block); +} + static tree gfc_trans_omp_barrier (void) { @@ -7280,6 +7322,8 @@ gfc_trans_omp_directive (gfc_code *code) { switch (code->op) { + case EXEC_OMP_ALLOCATE: + return gfc_trans_omp_allocate (code); case EXEC_OMP_ATOMIC: return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 new file mode 100644 index 00000000000..2de2b52ee44 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -0,0 +1,72 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module + + +subroutine foo(x, y, al) + use omp_lib_kinds + implicit none + +type :: my_type + integer :: i + integer :: j + real :: x +end type + + integer :: x + integer :: y + integer (kind=omp_allocator_handle_kind) :: al + + integer, allocatable :: var1 + integer, allocatable :: var2 + real, allocatable :: var3(:,:) + type (my_type), allocatable :: var4 + integer, pointer :: pii, parr(:) + + character, allocatable :: str1a, str1aarr(:) + character(len=5), allocatable :: str5a, str5aarr(:) + + !$omp allocate + allocate(str1a, str1aarr(10), str5a, str5aarr(10)) + + !$omp allocate (var1) allocator(omp_default_mem_alloc) + !$omp allocate (var2) allocator(omp_large_cap_mem_alloc) + allocate (var1, var2) + + !$omp allocate (var4) allocator(omp_low_lat_mem_alloc) + allocate (var4) + var4%i = 5 + + !$omp allocate (var3) allocator(omp_low_lat_mem_alloc) + allocate (var3(x,y)) + + !$omp allocate + allocate(pii, parr(5)) +end subroutine + +! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } } diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 61ae4bd931b..5bd5501e346 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -519,6 +519,9 @@ enum omp_clause_code { /* OpenACC clause: nohost. */ OMP_CLAUSE_NOHOST, + + /* OpenMP clause: allocator. */ + OMP_CLAUSE_ALLOCATOR, }; #undef DEFTREESTRUCT diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index 352662567b4..c3891a359f2 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -740,6 +740,20 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) pp_right_paren (pp); break; + case OMP_CLAUSE_ALLOCATOR: + pp_string (pp, "("); + dump_generic_node (pp, OMP_ALLOCATE_DECL (clause), + spc, flags, false); + if (OMP_ALLOCATE_ALLOCATOR (clause)) + { + pp_string (pp, ":allocator("); + dump_generic_node (pp, OMP_ALLOCATE_ALLOCATOR (clause), + spc, flags, false); + pp_right_paren (pp); + } + pp_right_paren (pp); + break; + case OMP_CLAUSE_ALLOCATE: pp_string (pp, "allocate("); if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (clause)) @@ -3484,6 +3498,11 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, dump_omp_clauses (pp, OACC_CACHE_CLAUSES (node), spc, flags); break; + case OMP_ALLOCATE: + pp_string (pp, "#pragma omp allocate "); + dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags); + break; + case OMP_PARALLEL: pp_string (pp, "#pragma omp parallel"); dump_omp_clauses (pp, OMP_PARALLEL_CLAUSES (node), spc, flags); diff --git a/gcc/tree.c b/gcc/tree.c index d98b77db50b..75141756d87 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -363,6 +363,7 @@ unsigned const char omp_clause_num_ops[] = 0, /* OMP_CLAUSE_IF_PRESENT */ 0, /* OMP_CLAUSE_FINALIZE */ 0, /* OMP_CLAUSE_NOHOST */ + 2, /* OMP_CLAUSE_ALLOCATOR */ }; const char * const omp_clause_code_name[] = diff --git a/gcc/tree.def b/gcc/tree.def index 33eb3b7beff..9768bc29dec 100644 --- a/gcc/tree.def +++ b/gcc/tree.def @@ -1301,6 +1301,10 @@ DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1) DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2) DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2) +/* OpenMP - #pragma omp allocate + Operand 0: Clauses. */ +DEFTREECODE (OMP_ALLOCATE, "omp allocate", tcc_statement, 1) + /* OpenMP clauses. */ DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0) diff --git a/gcc/tree.h b/gcc/tree.h index 318019c4dc5..2ec0b8c9240 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1405,6 +1405,8 @@ class auto_suppress_location_wrappers #define OACC_UPDATE_CLAUSES(NODE) \ TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0) +#define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0) + #define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0) #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1) @@ -1801,6 +1803,15 @@ class auto_suppress_location_wrappers #define OMP_CLAUSE_ALLOCATE_ALIGN(NODE) \ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE), 2) +/* May be we can use OMP_CLAUSE_DECL but the I am not sure where to place + OMP_CLAUSE_ALLOCATOR in omp_clause_code. */ + +#define OMP_ALLOCATE_DECL(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 0) + +#define OMP_ALLOCATE_ALLOCATOR(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 1) + /* True if an ALLOCATE clause was present on a combined or composite construct and the code for splitting the clauses has already performed checking if the listed variable has explicit privatization on the From patchwork Thu Jan 13 14:53:18 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 49972 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 5E3683951C63 for ; Thu, 13 Jan 2022 14:55:57 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 463A53951C1B; Thu, 13 Jan 2022 14:53:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 463A53951C1B 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: 4dqU0GOU2dFSs3Q6uCl/VriqNoS8VHjz4yCYjIPAo5cDYxPrgBPTq3nKIpTdsIJa9a/ekw0B4G i6ovmo2UqBTw+DLI630qA7BzFvXtH9ZrSInVogottFVTHArNRyoienfQasFHX8hxdL5LKqd88I Y1GBA0Hz2cJHkyi0BKiDDwr8TEMV7+dPJYpWBgg18pCaO8nOaZC3ei8SOjD5KHhst5IsqguHGS zTKevLas12WN9jgdj4V5+r1VYHT34BF9FtlH/JEM/fXS1LOC7IBsZXzgr7t8ebAlSGXFWjQLnG utYRWaZH1FXlbjKKDQeCb50U X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70723180" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:53:46 -0800 IronPort-SDR: jLzAvlxGxTtUzokzokUcnaqZoppMF2Ec6DAnhvSa3b2j874DEneY4/1sMY0DpsWvBv0xbYFsS1 80db+LVus1ofYzWXXqFy3HxSBEgMUmuKHbpLohZwzfrNdWjj2C2DIOQhVMFDWwV/JEC4cse4eN uEMOgjoNjnzlFNMsOAECcwisALkTVlDNQdoGnWMBO6NnWSO9GFQ1VPDpU47Ec7p/7naaxg8aj0 CrNnDy2e7J7MkYeCaRMCqYFJpORBFSZ95YZ9cmzP/0TzEgUwkUy/oNhR67Df5UvU1xwcVaqct2 3ik= From: Hafiz Abid Qadeer To: , Subject: [PATCH 3/5] [gfortran] Handle cleanup of omp allocated variables (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:18 +0000 Message-ID: <20220113145320.3153087-4-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113145320.3153087-1-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, 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 Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Currently we are only handling omp allocate directive that is associated with an allocate statement. This statement results in malloc and free calls. The malloc calls are easy to get to as they are in the same block as allocate directive. But the free calls come in a separate cleanup block. To help any later passes finding them, an allocate directive is generated in the cleanup block with kind=free. The normal allocate directive is given kind=allocate. gcc/fortran/ChangeLog: * gfortran.h (struct access_ref): Declare new members omp_allocated and omp_allocated_end. * openmp.c (gfc_match_omp_allocate): Set new_st.resolved_sym to NULL. (prepare_omp_allocated_var_list_for_cleanup): New function. (gfc_resolve_omp_allocate): Call it. * trans-decl.c (gfc_trans_deferred_vars): Process omp_allocated. * trans-openmp.c (gfc_trans_omp_allocate): Set kind for the stmt generated for allocate directive. gcc/ChangeLog: * tree-core.h (struct tree_base): Add comments. * tree-pretty-print.c (dump_generic_node): Handle allocate directive kind. * tree.h (OMP_ALLOCATE_KIND_ALLOCATE): New define. (OMP_ALLOCATE_KIND_FREE): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-6.f90: Test kind of allocate directive. --- gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 30 +++++++++++++++++++ gcc/fortran/trans-decl.c | 20 +++++++++++++ gcc/fortran/trans-openmp.c | 6 ++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 3 +- gcc/tree-core.h | 6 ++++ gcc/tree-pretty-print.c | 4 +++ gcc/tree.h | 4 +++ 8 files changed, 73 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 79a43a2fdf0..6a43847d31f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1820,6 +1820,7 @@ typedef struct gfc_symbol gfc_array_spec *as; struct gfc_symbol *result; /* function result symbol */ gfc_component *components; /* Derived type components */ + gfc_omp_namelist *omp_allocated, *omp_allocated_end; /* Defined only for Cray pointees; points to their pointer. */ struct gfc_symbol *cp_pointer; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index ee7c39980bb..f11812b0b12 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -5818,6 +5818,7 @@ gfc_match_omp_allocate (void) new_st.op = EXEC_OMP_ALLOCATE; new_st.ext.omp_clauses = c; + new_st.resolved_sym = NULL; gfc_free_expr (allocator); return MATCH_YES; } @@ -9049,6 +9050,34 @@ gfc_resolve_oacc_routines (gfc_namespace *ns) } } +static void +prepare_omp_allocated_var_list_for_cleanup (gfc_omp_namelist *cn, locus loc) +{ + gfc_symbol *proc = cn->sym->ns->proc_name; + gfc_omp_namelist *p, *n; + + for (n = cn; n; n = n->next) + { + if (n->sym->attr.allocatable && !n->sym->attr.save + && !n->sym->attr.result && !proc->attr.is_main_program) + { + p = gfc_get_omp_namelist (); + p->sym = n->sym; + p->expr = gfc_copy_expr (n->expr); + p->where = loc; + p->next = NULL; + if (proc->omp_allocated == NULL) + proc->omp_allocated_end = proc->omp_allocated = p; + else + { + proc->omp_allocated_end->next = p; + proc->omp_allocated_end = p; + } + + } + } +} + static void check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al, gfc_namespace *ns, locus loc) @@ -9179,6 +9208,7 @@ gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns) code->loc); } } + prepare_omp_allocated_var_list_for_cleanup (cn, code->loc); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 066fb3a5f61..e5c9bf413e7 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4583,6 +4583,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) } } + /* Generate a dummy allocate pragma with free kind so that cleanup + of those variables which were allocated using the allocate statement + associated with an allocate clause happens correctly. */ + + if (proc_sym->omp_allocated) + { + gfc_clear_new_st (); + new_st.op = EXEC_OMP_ALLOCATE; + gfc_omp_clauses *c = gfc_get_omp_clauses (); + c->lists[OMP_LIST_ALLOCATOR] = proc_sym->omp_allocated; + new_st.ext.omp_clauses = c; + /* This is just a hacky way to convey to handler that we are + dealing with cleanup here. Saves us from using another field + for it. */ + new_st.resolved_sym = proc_sym->omp_allocated->sym; + gfc_add_init_cleanup (block, NULL, + gfc_trans_omp_directive (&new_st)); + gfc_free_omp_clauses (c); + proc_sym->omp_allocated = NULL; + } /* Initialize the INTENT(OUT) derived type dummy arguments. This should be done here so that the offsets and lbounds of arrays diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index cb389f40370..12abc840642 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4925,6 +4925,12 @@ gfc_trans_omp_allocate (gfc_code *code) OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses, code->loc, false, true); + if (code->next == NULL && code->block == NULL + && code->resolved_sym != NULL) + OMP_ALLOCATE_KIND_FREE (stmt) = 1; + else + OMP_ALLOCATE_KIND_ALLOCATE (stmt) = 1; + gfc_add_expr_to_block (&block, stmt); gfc_merge_block_scope (&block); return gfc_finish_block (&block); diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 index 2de2b52ee44..0eb35178e03 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -69,4 +69,5 @@ end type allocate(pii, parr(5)) end subroutine -! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } } +! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } } diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 5bd5501e346..21b9a9a761b 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1241,6 +1241,9 @@ struct GTY(()) tree_base { EXPR_LOCATION_WRAPPER_P in NON_LVALUE_EXPR, VIEW_CONVERT_EXPR + OMP_ALLOCATE_KIND_ALLOCATE in + OMP_ALLOCATE + private_flag: TREE_PRIVATE in @@ -1267,6 +1270,9 @@ struct GTY(()) tree_base { ENUM_IS_OPAQUE in ENUMERAL_TYPE + OMP_ALLOCATE_KIND_FREE in + OMP_ALLOCATE + protected_flag: TREE_PROTECTED in diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index c3891a359f2..ae8623fe806 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -3500,6 +3500,10 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, case OMP_ALLOCATE: pp_string (pp, "#pragma omp allocate "); + if (OMP_ALLOCATE_KIND_ALLOCATE (node)) + pp_string (pp, "(kind=allocate) "); + else if (OMP_ALLOCATE_KIND_FREE (node)) + pp_string (pp, "(kind=free) "); dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags); break; diff --git a/gcc/tree.h b/gcc/tree.h index 2ec0b8c9240..4d099c9bf12 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1406,6 +1406,10 @@ class auto_suppress_location_wrappers TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0) #define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0) +#define OMP_ALLOCATE_KIND_ALLOCATE(NODE) \ + (OMP_ALLOCATE_CHECK (NODE)->base.public_flag) +#define OMP_ALLOCATE_KIND_FREE(NODE) \ + (OMP_ALLOCATE_CHECK (NODE)->base.private_flag) #define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0) #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1) From patchwork Thu Jan 13 14:53:19 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 49973 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 5A52A3951C04 for ; Thu, 13 Jan 2022 14:56:36 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id C4E073951C28; Thu, 13 Jan 2022 14:54:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org C4E073951C28 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: Dxh6OJ7QCAYRnV191dxtlyl7W1/41IvfokUaMfu9t8ImXiiLds8WjF1v4VCqPkrYcCOjeGFjj7 KJd8tiBg8l8nuFwXAFToJsQB0Ki/FDX8uCvEm5sZ1E33b0uhDBF2/Q3+xL3jwhpXjQkTyz6PaI NflaKjXSF8dEhnA4OAlzihoCVW71vsWhVNbB4fo2ffQFNr07v+nXK/jXq6hOgdVpcs2E+xbrvm KmmKxXpi9wLUCeouJ9KuQUlxp4mHPn5RBKKKe2+d1GzakCgVCDFJlSs38/XZMZMctHN500TJC1 Tabzn4X9qQYvpNiAiKYCjds9 X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70725143" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:53:59 -0800 IronPort-SDR: hQZIen2OQofR4AzFo+OSQ5lXc+wKVCliWY58FKZzelLQJc2vq9/MXaV7KKVuSOX48GSgXnErUf 3vqwE1GnACgQdgoXryurMsWTTINVT/P7bKsYNfBxNz975PJA+6wj4ubWbA/BdkQPDYcE+L6gPd JU7cgZBE0SSOI8Labjm6dO9If5uEOijSJcjolj8GZWTSafHSOecp9jGxWlO5h7SNXQY3ik3XC9 JHp91D+skPao1rS52GGffSftt40wk+SOj4OiHAgfi6RmLh0iQpIJgj6UaiOatK/wOPTfBEgCMH lFw= From: Hafiz Abid Qadeer To: , Subject: [PATCH 4/5] [gfortran] Gimplify allocate directive (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:19 +0000 Message-ID: <20220113145320.3153087-5-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113145320.3153087-1-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, 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 Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" gcc/ChangeLog: * doc/gimple.texi: Describe GIMPLE_OMP_ALLOCATE. * gimple-pretty-print.c (dump_gimple_omp_allocate): New function. (pp_gimple_stmt_1): Call it. * gimple.c (gimple_build_omp_allocate): New function. * gimple.def (GIMPLE_OMP_ALLOCATE): New node. * gimple.h (enum gf_mask): Add GF_OMP_ALLOCATE_KIND_MASK, GF_OMP_ALLOCATE_KIND_ALLOCATE and GF_OMP_ALLOCATE_KIND_FREE. (struct gomp_allocate): New. (is_a_helper ::test): New. (is_a_helper ::test): New. (gimple_build_omp_allocate): Declare. (gimple_omp_subcode): Replace GIMPLE_OMP_TEAMS with GIMPLE_OMP_ALLOCATE. (gimple_omp_allocate_set_clauses): New. (gimple_omp_allocate_set_kind): Likewise. (gimple_omp_allocate_clauses): Likewise. (gimple_omp_allocate_kind): Likewise. (CASE_GIMPLE_OMP): Add GIMPLE_OMP_ALLOCATE. * gimplify.c (gimplify_omp_allocate): New. (gimplify_expr): Call it. * gsstruct.def (GSS_OMP_ALLOCATE): Define. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-6.f90: Add tests. --- gcc/doc/gimple.texi | 38 +++++++++++- gcc/gimple-pretty-print.c | 37 ++++++++++++ gcc/gimple.c | 10 ++++ gcc/gimple.def | 6 ++ gcc/gimple.h | 60 ++++++++++++++++++- gcc/gimplify.c | 19 ++++++ gcc/gsstruct.def | 1 + gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 4 +- 8 files changed, 171 insertions(+), 4 deletions(-) diff --git a/gcc/doc/gimple.texi b/gcc/doc/gimple.texi index 65ef63d6ee9..60a4d2c17ca 100644 --- a/gcc/doc/gimple.texi +++ b/gcc/doc/gimple.texi @@ -420,6 +420,9 @@ kinds, along with their relationships to @code{GSS_} values (layouts) and + gomp_continue | layout: GSS_OMP_CONTINUE, code: GIMPLE_OMP_CONTINUE | + + gomp_allocate + | layout: GSS_OMP_ALLOCATE, code: GIMPLE_OMP_ALLOCATE + | + gomp_atomic_load | layout: GSS_OMP_ATOMIC_LOAD, code: GIMPLE_OMP_ATOMIC_LOAD | @@ -454,6 +457,7 @@ The following table briefly describes the GIMPLE instruction set. @item @code{GIMPLE_GOTO} @tab x @tab x @item @code{GIMPLE_LABEL} @tab x @tab x @item @code{GIMPLE_NOP} @tab x @tab x +@item @code{GIMPLE_OMP_ALLOCATE} @tab x @tab x @item @code{GIMPLE_OMP_ATOMIC_LOAD} @tab x @tab x @item @code{GIMPLE_OMP_ATOMIC_STORE} @tab x @tab x @item @code{GIMPLE_OMP_CONTINUE} @tab x @tab x @@ -1029,6 +1033,7 @@ Return a deep copy of statement @code{STMT}. * @code{GIMPLE_LABEL}:: * @code{GIMPLE_GOTO}:: * @code{GIMPLE_NOP}:: +* @code{GIMPLE_OMP_ALLOCATE}:: * @code{GIMPLE_OMP_ATOMIC_LOAD}:: * @code{GIMPLE_OMP_ATOMIC_STORE}:: * @code{GIMPLE_OMP_CONTINUE}:: @@ -1729,6 +1734,38 @@ Build a @code{GIMPLE_NOP} statement. Returns @code{TRUE} if statement @code{G} is a @code{GIMPLE_NOP}. @end deftypefn +@node @code{GIMPLE_OMP_ALLOCATE} +@subsection @code{GIMPLE_OMP_ALLOCATE} +@cindex @code{GIMPLE_OMP_ALLOCATE} + +@deftypefn {GIMPLE function} gomp_allocate *gimple_build_omp_allocate ( @ +tree clauses, int kind) +Build a @code{GIMPLE_OMP_ALLOCATE} statement. @code{CLAUSES} is the clauses +associated with this node. @code{KIND} is the enumeration value +@code{GF_OMP_ALLOCATE_KIND_ALLOCATE} if this directive allocates memory +or @code{GF_OMP_ALLOCATE_KIND_FREE} if it de-allocates. +@end deftypefn + +@deftypefn {GIMPLE function} void gimple_omp_allocate_set_clauses ( @ +gomp_allocate *g, tree clauses) +Set the @code{CLAUSES} for a @code{GIMPLE_OMP_ALLOCATE}. +@end deftypefn + +@deftypefn {GIMPLE function} tree gimple_omp_aallocate_clauses ( @ +const gomp_allocate *g) +Get the @code{CLAUSES} of a @code{GIMPLE_OMP_ALLOCATE}. +@end deftypefn + +@deftypefn {GIMPLE function} void gimple_omp_allocate_set_kind ( @ +gomp_allocate *g, int kind) +Set the @code{KIND} for a @code{GIMPLE_OMP_ALLOCATE}. +@end deftypefn + +@deftypefn {GIMPLE function} tree gimple_omp_allocate_kind ( @ +const gomp_atomic_load *g) +Get the @code{KIND} of a @code{GIMPLE_OMP_ALLOCATE}. +@end deftypefn + @node @code{GIMPLE_OMP_ATOMIC_LOAD} @subsection @code{GIMPLE_OMP_ATOMIC_LOAD} @cindex @code{GIMPLE_OMP_ATOMIC_LOAD} @@ -1760,7 +1797,6 @@ const gomp_atomic_load *g) Get the @code{RHS} of an atomic set. @end deftypefn - @node @code{GIMPLE_OMP_ATOMIC_STORE} @subsection @code{GIMPLE_OMP_ATOMIC_STORE} @cindex @code{GIMPLE_OMP_ATOMIC_STORE} diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c index ebd87b20a0a..bb961a900df 100644 --- a/gcc/gimple-pretty-print.c +++ b/gcc/gimple-pretty-print.c @@ -1967,6 +1967,38 @@ dump_gimple_omp_critical (pretty_printer *buffer, const gomp_critical *gs, } } +static void +dump_gimple_omp_allocate (pretty_printer *buffer, const gomp_allocate *gs, + int spc, dump_flags_t flags) +{ + if (flags & TDF_RAW) + { + const char *kind=""; + switch (gimple_omp_allocate_kind (gs)) + { + case GF_OMP_ALLOCATE_KIND_ALLOCATE: + kind = "allocate"; + break; + case GF_OMP_ALLOCATE_KIND_FREE: + kind = "free"; + break; + } + dump_gimple_fmt (buffer, spc, flags, "%G >"); + } + else + { + pp_string (buffer, "#pragma omp allocate "); + if (gimple_omp_allocate_kind (gs) == GF_OMP_ALLOCATE_KIND_ALLOCATE) + pp_string (buffer, "(kind=allocate) "); + else if (gimple_omp_allocate_kind (gs) == GF_OMP_ALLOCATE_KIND_FREE) + pp_string (buffer, "(kind=free) "); + + dump_omp_clauses (buffer, gimple_omp_allocate_clauses (gs), spc, flags); + } +} + /* Dump a GIMPLE_OMP_ORDERED tuple on the pretty_printer BUFFER. */ static void @@ -2823,6 +2855,11 @@ pp_gimple_stmt_1 (pretty_printer *buffer, const gimple *gs, int spc, flags); break; + case GIMPLE_OMP_ALLOCATE: + dump_gimple_omp_allocate (buffer, as_a (gs), spc, + flags); + break; + case GIMPLE_CATCH: dump_gimple_catch (buffer, as_a (gs), spc, flags); break; diff --git a/gcc/gimple.c b/gcc/gimple.c index 4c02df5aeea..2e70817ec32 100644 --- a/gcc/gimple.c +++ b/gcc/gimple.c @@ -1267,6 +1267,16 @@ gimple_build_omp_atomic_store (tree val, enum omp_memory_order mo) return p; } +gomp_allocate * +gimple_build_omp_allocate (tree clauses, int kind) +{ + gomp_allocate *p + = as_a (gimple_alloc (GIMPLE_OMP_ALLOCATE, 0)); + gimple_omp_allocate_set_clauses (p, clauses); + gimple_omp_allocate_set_kind (p, kind); + return p; +} + /* Build a GIMPLE_TRANSACTION statement. */ gtransaction * diff --git a/gcc/gimple.def b/gcc/gimple.def index 296c73c2d52..079565c3920 100644 --- a/gcc/gimple.def +++ b/gcc/gimple.def @@ -388,6 +388,12 @@ DEFGSCODE(GIMPLE_OMP_TARGET, "gimple_omp_target", GSS_OMP_PARALLEL_LAYOUT) CHILD_FN and DATA_ARG like for GIMPLE_OMP_PARALLEL. */ DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT) +/* GIMPLE_OMP_ALLOCATE represents + #pragma omp allocate + CLAUSES is an OMP_CLAUSE chain holding the associated clauses which hold + variables to be allocated. */ +DEFGSCODE(GIMPLE_OMP_ALLOCATE, "gimple_omp_allocate", GSS_OMP_ALLOCATE) + /* GIMPLE_OMP_ORDERED represents #pragma omp ordered. BODY is the sequence of statements to execute in the ordered section. CLAUSES is an OMP_CLAUSE chain holding the associated clauses. */ diff --git a/gcc/gimple.h b/gcc/gimple.h index 7935073195b..97632edf5b9 100644 --- a/gcc/gimple.h +++ b/gcc/gimple.h @@ -150,6 +150,9 @@ enum gf_mask { GF_CALL_BY_DESCRIPTOR = 1 << 10, GF_CALL_NOCF_CHECK = 1 << 11, GF_CALL_FROM_NEW_OR_DELETE = 1 << 12, + GF_OMP_ALLOCATE_KIND_MASK = (1 << 2) - 1, + GF_OMP_ALLOCATE_KIND_ALLOCATE = 1, + GF_OMP_ALLOCATE_KIND_FREE = 2, GF_OMP_PARALLEL_COMBINED = 1 << 0, GF_OMP_TASK_TASKLOOP = 1 << 0, GF_OMP_TASK_TASKWAIT = 1 << 1, @@ -796,6 +799,17 @@ struct GTY((tag("GSS_OMP_ATOMIC_LOAD"))) tree rhs, lhs; }; +/* GSS_OMP_ALLOCATE. */ + +struct GTY((tag("GSS_OMP_ALLOCATE"))) + gomp_allocate : public gimple +{ + /* [ WORD 1-6 ] : base class */ + + /* [ WORD 7 ] */ + tree clauses; +}; + /* GIMPLE_OMP_ATOMIC_STORE. See note on GIMPLE_OMP_ATOMIC_LOAD. */ @@ -1129,6 +1143,14 @@ is_a_helper ::test (gimple *gs) return gs->code == GIMPLE_OMP_ATOMIC_STORE; } +template <> +template <> +inline bool +is_a_helper ::test (gimple *gs) +{ + return gs->code == GIMPLE_OMP_ALLOCATE; +} + template <> template <> inline bool @@ -1371,6 +1393,14 @@ is_a_helper ::test (const gimple *gs) return gs->code == GIMPLE_OMP_ATOMIC_STORE; } +template <> +template <> +inline bool +is_a_helper ::test (const gimple *gs) +{ + return gs->code == GIMPLE_OMP_ALLOCATE; +} + template <> template <> inline bool @@ -1572,6 +1602,7 @@ gomp_sections *gimple_build_omp_sections (gimple_seq, tree); gimple *gimple_build_omp_sections_switch (void); gomp_single *gimple_build_omp_single (gimple_seq, tree); gomp_target *gimple_build_omp_target (gimple_seq, int, tree); +gomp_allocate *gimple_build_omp_allocate (tree, int); gomp_teams *gimple_build_omp_teams (gimple_seq, tree); gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree, enum omp_memory_order); @@ -2311,7 +2342,7 @@ static inline unsigned gimple_omp_subcode (const gimple *s) { gcc_gimple_checking_assert (gimple_code (s) >= GIMPLE_OMP_ATOMIC_LOAD - && gimple_code (s) <= GIMPLE_OMP_TEAMS); + && gimple_code (s) <= GIMPLE_OMP_ALLOCATE); return s->subcode; } @@ -6355,6 +6386,30 @@ gimple_omp_sections_set_control (gimple *gs, tree control) omp_sections_stmt->control = control; } +static inline void +gimple_omp_allocate_set_clauses (gomp_allocate *gs, tree c) +{ + gs->clauses = c; +} + +static inline void +gimple_omp_allocate_set_kind (gomp_allocate *gs, int kind) +{ + gs->subcode = (gs->subcode & ~GF_OMP_ALLOCATE_KIND_MASK) + | (kind & GF_OMP_ALLOCATE_KIND_MASK); +} + +static inline tree +gimple_omp_allocate_clauses (const gomp_allocate *gs) +{ + return gs->clauses; +} + +static inline int +gimple_omp_allocate_kind (const gomp_allocate *gs) +{ + return (gimple_omp_subcode (gs) & GF_OMP_ALLOCATE_KIND_MASK); +} /* Set the value being stored in an atomic store. */ @@ -6638,7 +6693,8 @@ gimple_return_set_retval (greturn *gs, tree retval) case GIMPLE_OMP_RETURN: \ case GIMPLE_OMP_ATOMIC_LOAD: \ case GIMPLE_OMP_ATOMIC_STORE: \ - case GIMPLE_OMP_CONTINUE + case GIMPLE_OMP_CONTINUE: \ + case GIMPLE_OMP_ALLOCATE static inline bool is_gimple_omp (const gimple *stmt) diff --git a/gcc/gimplify.c b/gcc/gimplify.c index d1b27d7f46f..ea080cca72e 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -14103,6 +14103,21 @@ gimplify_omp_workshare (tree *expr_p, gimple_seq *pre_p) *expr_p = NULL_TREE; } +static void +gimplify_omp_allocate (tree *expr_p, gimple_seq *pre_p) +{ + tree expr = *expr_p; + int kind; + if (OMP_ALLOCATE_KIND_ALLOCATE (expr)) + kind = GF_OMP_ALLOCATE_KIND_ALLOCATE; + else + kind = GF_OMP_ALLOCATE_KIND_FREE; + gimple *stmt = gimple_build_omp_allocate (OMP_ALLOCATE_CLAUSES (expr), + kind); + gimplify_seq_add_stmt (pre_p, stmt); + *expr_p = NULL_TREE; +} + /* Gimplify the gross structure of OpenACC enter/exit data, update, and OpenMP target update constructs. */ @@ -15492,6 +15507,10 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p, gimplify_omp_target_update (expr_p, pre_p); ret = GS_ALL_DONE; break; + case OMP_ALLOCATE: + gimplify_omp_allocate (expr_p, pre_p); + ret = GS_ALL_DONE; + break; case OMP_SECTION: case OMP_MASTER: diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def index 19e1088b718..9c7526596e8 100644 --- a/gcc/gsstruct.def +++ b/gcc/gsstruct.def @@ -50,4 +50,5 @@ DEFGSSTRUCT(GSS_OMP_SINGLE_LAYOUT, gimple_statement_omp_single_layout, false) DEFGSSTRUCT(GSS_OMP_CONTINUE, gomp_continue, false) DEFGSSTRUCT(GSS_OMP_ATOMIC_LOAD, gomp_atomic_load, false) DEFGSSTRUCT(GSS_OMP_ATOMIC_STORE_LAYOUT, gomp_atomic_store, false) +DEFGSSTRUCT(GSS_OMP_ALLOCATE, gomp_allocate, false) DEFGSSTRUCT(GSS_TRANSACTION, gtransaction, false) diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 index 0eb35178e03..6957bc55da0 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-additional-options "-fdump-tree-original" } +! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" } module omp_lib_kinds use iso_c_binding, only: c_int, c_intptr_t @@ -71,3 +71,5 @@ end subroutine ! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } } ! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "gimple" } } +! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "gimple" } } From patchwork Thu Jan 13 14:53:20 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 49974 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 55A783951C7E for ; Thu, 13 Jan 2022 14:57:26 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 079163951C3C; Thu, 13 Jan 2022 14:54:03 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 079163951C3C 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: L4J9X2OfC5eOFSrFad8iP4H6cWwuVDCvUIivoX+j7iQe5go5rCPntgiIbUQqzxjIbjcpCtnd1K GP9cY1ecjojkXbi8AKp9v+RON2fsMMoqhQMSxVfM8ZFLbdXTvqhKmsAlhEsb6VPaJ3+Tf3NpmL ldsUJ+c43dOj2MOgVEpfqhTeBwp9/AJARTulF9L0k/90a1CFvQrYXyZYTZC5gc3NRGL4E7YSdq 5xm/W/i0xYnROLhZUAKeIowIPCXdXiX0ydSiqzvNmLUAU7uTz2LfkYcIK7A3VrZFvPdnbI/CLx 3+o/0OwhEmZLTHhr0pLD/351 X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70725145" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:54:03 -0800 IronPort-SDR: IRrTiz563tFhqIgg4l3qnfCNPwFtemjIFP2pgxnFL9bRC9AJmNmxGKxAcVJUvaBoSBmc4KDVIw GvR/pA3UVYpD3qPIGvrpx+HDwUSdC6bcrYFqgKK1oYTqzgaAR/N0k7FDCXySS75Ag4vrpsB7QJ vBZFZJwZnGkj7GnnOt6tC1/i1AHocBSK5DPcqj9djOHGRmZg6M18mMxIG23PxR/uQ3F/1BjM4j Pk/Kw+NqcS7RsaqICnnSSfPmwziU0VSvFEYaIAiDtTiLxVdSAmjvlNnZKwPcoO53gT967QviIF 4PA= From: Hafiz Abid Qadeer To: , Subject: [PATCH 5/5] [gfortran] Lower allocate directive (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:20 +0000 Message-ID: <20220113145320.3153087-6-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113145320.3153087-1-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-2.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, UNWANTED_LANGUAGE_BODY 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 Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch looks for malloc/free calls that were generated by allocate statement that is associated with allocate directive and replaces them with GOMP_alloc and GOMP_free. gcc/ChangeLog: * omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_ALLOCATOR. (scan_omp_allocate): New. (scan_omp_1_stmt): Call it. (lower_omp_allocate): New function. (lower_omp_1): Call it. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-6.f90: Add tests. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.c: New test. * testsuite/libgomp.fortran/allocate-2.f90: New test. --- gcc/omp-low.c | 125 ++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 9 ++ .../testsuite/libgomp.fortran/allocate-1.c | 7 + .../testsuite/libgomp.fortran/allocate-2.f90 | 49 +++++++ 4 files changed, 190 insertions(+) create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-2.f90 diff --git a/gcc/omp-low.c b/gcc/omp-low.c index f2237428de1..8a0ae3932b9 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -1684,6 +1684,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) case OMP_CLAUSE_FINALIZE: case OMP_CLAUSE_TASK_REDUCTION: case OMP_CLAUSE_ALLOCATE: + case OMP_CLAUSE_ALLOCATOR: break; case OMP_CLAUSE_ALIGNED: @@ -1892,6 +1893,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) case OMP_CLAUSE_FINALIZE: case OMP_CLAUSE_FILTER: case OMP_CLAUSE__CONDTEMP_: + case OMP_CLAUSE_ALLOCATOR: break; case OMP_CLAUSE__CACHE_: @@ -2962,6 +2964,16 @@ scan_omp_simd_scan (gimple_stmt_iterator *gsi, gomp_for *stmt, maybe_lookup_ctx (new_stmt)->for_simd_scan_phase = true; } +/* Scan an OpenMP allocate directive. */ + +static void +scan_omp_allocate (gomp_allocate *stmt, omp_context *outer_ctx) +{ + omp_context *ctx; + ctx = new_omp_context (stmt, outer_ctx); + scan_sharing_clauses (gimple_omp_allocate_clauses (stmt), ctx); +} + /* Scan an OpenMP sections directive. */ static void @@ -4247,6 +4259,9 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p, insert_decl_map (&ctx->cb, var, var); } break; + case GIMPLE_OMP_ALLOCATE: + scan_omp_allocate (as_a (stmt), ctx); + break; default: *handled_ops_p = false; break; @@ -8680,6 +8695,111 @@ lower_omp_single_simple (gomp_single *single_stmt, gimple_seq *pre_p) gimple_seq_add_stmt (pre_p, gimple_build_label (flabel)); } +static void +lower_omp_allocate (gimple_stmt_iterator *gsi_p, omp_context *) +{ + gomp_allocate *st = as_a (gsi_stmt (*gsi_p)); + tree clauses = gimple_omp_allocate_clauses (st); + int kind = gimple_omp_allocate_kind (st); + gcc_assert (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE + || kind == GF_OMP_ALLOCATE_KIND_FREE); + bool allocate = (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE); + + for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c)) + { + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_ALLOCATOR) + continue; + tree var = OMP_ALLOCATE_DECL (c); + + gimple_stmt_iterator gsi = *gsi_p; + for (gsi_next (&gsi); !gsi_end_p (gsi); gsi_next (&gsi)) + { + gimple *stmt = gsi_stmt (gsi); + + if (gimple_code (stmt) != GIMPLE_CALL + || (allocate && gimple_call_fndecl (stmt) + != builtin_decl_explicit (BUILT_IN_MALLOC)) + || (!allocate && gimple_call_fndecl (stmt) + != builtin_decl_explicit (BUILT_IN_FREE))) + continue; + const gcall *gs = as_a (stmt); + tree allocator = OMP_ALLOCATE_ALLOCATOR (c) + ? OMP_ALLOCATE_ALLOCATOR (c) + : integer_zero_node; + if (allocate) + { + tree lhs = gimple_call_lhs (gs); + if (lhs && TREE_CODE (lhs) == SSA_NAME) + { + gimple_stmt_iterator gsi2 = gsi; + gsi_next (&gsi2); + gimple *assign = gsi_stmt (gsi2); + if (gimple_code (assign) == GIMPLE_ASSIGN) + { + lhs = gimple_assign_lhs (as_a (assign)); + if (lhs == NULL_TREE + || TREE_CODE (lhs) != COMPONENT_REF) + continue; + lhs = TREE_OPERAND (lhs, 0); + } + } + + if (lhs == var) + { + unsigned HOST_WIDE_INT ialign = 0; + tree align; + if (TYPE_P (var)) + ialign = TYPE_ALIGN_UNIT (var); + else + ialign = DECL_ALIGN_UNIT (var); + align = build_int_cst (size_type_node, ialign); + tree repl = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC); + tree size = gimple_call_arg (gs, 0); + gimple *g = gimple_build_call (repl, 3, align, size, + allocator); + gimple_call_set_lhs (g, gimple_call_lhs (gs)); + gimple_set_location (g, gimple_location (stmt)); + gsi_replace (&gsi, g, true); + } + } + else + { + tree arg = gimple_call_arg (gs, 0); + if (arg && TREE_CODE (arg) == SSA_NAME) + { + gimple_stmt_iterator gsi2 = gsi; + gsi_prev (&gsi2); + if (!gsi_end_p (gsi2)) + { + gimple *gs = gsi_stmt (gsi2); + if (gimple_code (gs) == GIMPLE_ASSIGN) + { + const gassign *assign = as_a (gs); + tree rhs = gimple_assign_rhs1 (assign); + tree lhs = gimple_assign_lhs (assign); + if (lhs == arg && rhs + && TREE_CODE (rhs) == COMPONENT_REF) + arg = TREE_OPERAND (rhs, 0); + } + } + } + + if (arg == var) + { + tree repl = builtin_decl_explicit (BUILT_IN_GOMP_FREE); + gimple *g = gimple_build_call (repl, 2, + gimple_call_arg (gs, 0), + allocator); + gimple_set_location (g, gimple_location (stmt)); + gsi_replace (&gsi, g, true); + break; + } + } + } + } + gsi_replace (gsi_p, gimple_build_nop (), true); +} + /* A subroutine of lower_omp_single. Expand the simple form of a GIMPLE_OMP_SINGLE, with a copyprivate clause: @@ -14179,6 +14299,11 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx) gcc_assert (ctx); lower_omp_scope (gsi_p, ctx); break; + case GIMPLE_OMP_ALLOCATE: + ctx = maybe_lookup_ctx (stmt); + gcc_assert (ctx); + lower_omp_allocate (gsi_p, ctx); + break; case GIMPLE_OMP_SINGLE: ctx = maybe_lookup_ctx (stmt); gcc_assert (ctx); diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 index 6957bc55da0..738d9936f6a 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -1,5 +1,6 @@ ! { dg-do compile } ! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" } +! { dg-additional-options "-fdump-tree-omplower" } module omp_lib_kinds use iso_c_binding, only: c_int, c_intptr_t @@ -47,6 +48,7 @@ end type real, allocatable :: var3(:,:) type (my_type), allocatable :: var4 integer, pointer :: pii, parr(:) + integer, allocatable :: var character, allocatable :: str1a, str1aarr(:) character(len=5), allocatable :: str5a, str5aarr(:) @@ -67,9 +69,16 @@ end type !$omp allocate allocate(pii, parr(5)) + + ! allocate statement not associated with an allocate directive + allocate(var) end subroutine ! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } } ! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } } ! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "gimple" } } ! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "gimple" } } +! { dg-final { scan-tree-dump-times "builtin_malloc" 11 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 9 "original" } } +! { dg-final { scan-tree-dump-times "GOMP_alloc" 10 "omplower" } } +! { dg-final { scan-tree-dump-times "GOMP_free" 8 "omplower" } } diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c new file mode 100644 index 00000000000..d33acc6feef --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c @@ -0,0 +1,7 @@ +#include + +int +is_64bit_aligned_ (uintptr_t a) +{ + return ( (a & 0x3f) == 0); +} diff --git a/libgomp/testsuite/libgomp.fortran/allocate-2.f90 b/libgomp/testsuite/libgomp.fortran/allocate-2.f90 new file mode 100644 index 00000000000..8678c53a34c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-2.f90 @@ -0,0 +1,49 @@ +! { dg-do run } +! { dg-additional-sources allocate-1.c } +! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" } + +module m + use omp_lib + use iso_c_binding + implicit none + interface + integer(c_int) function is_64bit_aligned (a) bind(C) + import :: c_int + integer :: a + end + end interface +end module m + +subroutine foo (x, y, h) + use omp_lib + !use iso_c_binding + integer :: x + integer :: y + integer (kind=omp_allocator_handle_kind) :: h + integer, allocatable :: var1 + !integer, allocatable :: var2(:) + + !$omp allocate (var1) allocator(h) + allocate (var1) + + !y = 1 + if (is_64bit_aligned(var1) == 0) then + stop 19 + end if + +end subroutine + +program main + use omp_lib + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a + + traits = [omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 8192)] + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) stop 1 + !call omp_set_default_allocator (omp_default_mem_alloc); + call foo (42, 12, a); + call omp_destroy_allocator (a); +end