From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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: , CC: , 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 Content-Transfer-Encoding: 8bit Content-Type: text/plain 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: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 13 Jan 2022 14:53:52 -0000 Currently we are only handling omp allocate directive that is associated with an allocate statement. This statement results in malloc and free calls. The malloc calls are easy to get to as they are in the same block as allocate directive. But the free calls come in a separate cleanup block. To help any later passes finding them, an allocate directive is generated in the cleanup block with kind=free. The normal allocate directive is given kind=allocate. gcc/fortran/ChangeLog: * gfortran.h (struct access_ref): Declare new members omp_allocated and omp_allocated_end. * openmp.c (gfc_match_omp_allocate): Set new_st.resolved_sym to NULL. (prepare_omp_allocated_var_list_for_cleanup): New function. (gfc_resolve_omp_allocate): Call it. * trans-decl.c (gfc_trans_deferred_vars): Process omp_allocated. * trans-openmp.c (gfc_trans_omp_allocate): Set kind for the stmt generated for allocate directive. gcc/ChangeLog: * tree-core.h (struct tree_base): Add comments. * tree-pretty-print.c (dump_generic_node): Handle allocate directive kind. * tree.h (OMP_ALLOCATE_KIND_ALLOCATE): New define. (OMP_ALLOCATE_KIND_FREE): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-6.f90: Test kind of allocate directive. --- gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 30 +++++++++++++++++++ gcc/fortran/trans-decl.c | 20 +++++++++++++ gcc/fortran/trans-openmp.c | 6 ++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 3 +- gcc/tree-core.h | 6 ++++ gcc/tree-pretty-print.c | 4 +++ gcc/tree.h | 4 +++ 8 files changed, 73 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 79a43a2fdf0..6a43847d31f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1820,6 +1820,7 @@ typedef struct gfc_symbol gfc_array_spec *as; struct gfc_symbol *result; /* function result symbol */ gfc_component *components; /* Derived type components */ + gfc_omp_namelist *omp_allocated, *omp_allocated_end; /* Defined only for Cray pointees; points to their pointer. */ struct gfc_symbol *cp_pointer; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index ee7c39980bb..f11812b0b12 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -5818,6 +5818,7 @@ gfc_match_omp_allocate (void) new_st.op = EXEC_OMP_ALLOCATE; new_st.ext.omp_clauses = c; + new_st.resolved_sym = NULL; gfc_free_expr (allocator); return MATCH_YES; } @@ -9049,6 +9050,34 @@ gfc_resolve_oacc_routines (gfc_namespace *ns) } } +static void +prepare_omp_allocated_var_list_for_cleanup (gfc_omp_namelist *cn, locus loc) +{ + gfc_symbol *proc = cn->sym->ns->proc_name; + gfc_omp_namelist *p, *n; + + for (n = cn; n; n = n->next) + { + if (n->sym->attr.allocatable && !n->sym->attr.save + && !n->sym->attr.result && !proc->attr.is_main_program) + { + p = gfc_get_omp_namelist (); + p->sym = n->sym; + p->expr = gfc_copy_expr (n->expr); + p->where = loc; + p->next = NULL; + if (proc->omp_allocated == NULL) + proc->omp_allocated_end = proc->omp_allocated = p; + else + { + proc->omp_allocated_end->next = p; + proc->omp_allocated_end = p; + } + + } + } +} + static void check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al, gfc_namespace *ns, locus loc) @@ -9179,6 +9208,7 @@ gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns) code->loc); } } + prepare_omp_allocated_var_list_for_cleanup (cn, code->loc); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 066fb3a5f61..e5c9bf413e7 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4583,6 +4583,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) } } + /* Generate a dummy allocate pragma with free kind so that cleanup + of those variables which were allocated using the allocate statement + associated with an allocate clause happens correctly. */ + + if (proc_sym->omp_allocated) + { + gfc_clear_new_st (); + new_st.op = EXEC_OMP_ALLOCATE; + gfc_omp_clauses *c = gfc_get_omp_clauses (); + c->lists[OMP_LIST_ALLOCATOR] = proc_sym->omp_allocated; + new_st.ext.omp_clauses = c; + /* This is just a hacky way to convey to handler that we are + dealing with cleanup here. Saves us from using another field + for it. */ + new_st.resolved_sym = proc_sym->omp_allocated->sym; + gfc_add_init_cleanup (block, NULL, + gfc_trans_omp_directive (&new_st)); + gfc_free_omp_clauses (c); + proc_sym->omp_allocated = NULL; + } /* Initialize the INTENT(OUT) derived type dummy arguments. This should be done here so that the offsets and lbounds of arrays diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index cb389f40370..12abc840642 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4925,6 +4925,12 @@ gfc_trans_omp_allocate (gfc_code *code) OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses, code->loc, false, true); + if (code->next == NULL && code->block == NULL + && code->resolved_sym != NULL) + OMP_ALLOCATE_KIND_FREE (stmt) = 1; + else + OMP_ALLOCATE_KIND_ALLOCATE (stmt) = 1; + gfc_add_expr_to_block (&block, stmt); gfc_merge_block_scope (&block); return gfc_finish_block (&block); diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 index 2de2b52ee44..0eb35178e03 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -69,4 +69,5 @@ end type allocate(pii, parr(5)) end subroutine -! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)" 6 "original" } } +! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "original" } } diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 5bd5501e346..21b9a9a761b 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1241,6 +1241,9 @@ struct GTY(()) tree_base { EXPR_LOCATION_WRAPPER_P in NON_LVALUE_EXPR, VIEW_CONVERT_EXPR + OMP_ALLOCATE_KIND_ALLOCATE in + OMP_ALLOCATE + private_flag: TREE_PRIVATE in @@ -1267,6 +1270,9 @@ struct GTY(()) tree_base { ENUM_IS_OPAQUE in ENUMERAL_TYPE + OMP_ALLOCATE_KIND_FREE in + OMP_ALLOCATE + protected_flag: TREE_PROTECTED in diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c index c3891a359f2..ae8623fe806 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -3500,6 +3500,10 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, case OMP_ALLOCATE: pp_string (pp, "#pragma omp allocate "); + if (OMP_ALLOCATE_KIND_ALLOCATE (node)) + pp_string (pp, "(kind=allocate) "); + else if (OMP_ALLOCATE_KIND_FREE (node)) + pp_string (pp, "(kind=free) "); dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags); break; diff --git a/gcc/tree.h b/gcc/tree.h index 2ec0b8c9240..4d099c9bf12 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1406,6 +1406,10 @@ class auto_suppress_location_wrappers TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0) #define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0) +#define OMP_ALLOCATE_KIND_ALLOCATE(NODE) \ + (OMP_ALLOCATE_CHECK (NODE)->base.public_flag) +#define OMP_ALLOCATE_KIND_FREE(NODE) \ + (OMP_ALLOCATE_CHECK (NODE)->base.private_flag) #define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0) #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1) -- 2.25.1