From patchwork Mon Aug 22 21:22:08 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 110993 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id B0BA6B6F83 for ; Tue, 23 Aug 2011 07:22:37 +1000 (EST) Received: (qmail 10734 invoked by alias); 22 Aug 2011 21:22:33 -0000 Received: (qmail 10718 invoked by uid 22791); 22 Aug 2011 21:22:31 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 22 Aug 2011 21:22:11 +0000 Received: from [192.168.178.22] (port-92-204-66-235.dynamic.qsc.de [92.204.66.235]) by mx02.qsc.de (Postfix) with ESMTP id 8959E2968C; Mon, 22 Aug 2011 23:22:08 +0200 (CEST) Message-ID: <4E52C880.8020208@net-b.de> Date: Mon, 22 Aug 2011 23:22:08 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:6.0) Gecko/20110812 Thunderbird/6.0 MIME-Version: 1.0 To: gfortran , gcc patches Subject: [Patch, Fortran] Coarray assumed-shape token and offset handling Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Dear all, this patch added token/offset support for assumed-shape coarray dummies (with .-fcoarray=lib). Build and regtested. OK for the trunk? * * * BACKGROUND For coarrays with -fcoarray=lib, for remote access, one needs to know two things: token and offset. a) A token (of type "void *") identifies the coarray in the library; its value is set when the coarray is registered. (For instance, it could store the base address of the coarray on all images). b) The offset between the base address of the coarray and the value one wants to assign. Recall, if type(t) :: a(:)[*] is a coarray (is this case: an assumed-shape dummy argument), then all of the following are also coarrays: a, a(1:4), a(1), a(1)%direct_comp, a(2)%direct_comp(2:7), a(4)%direct_comp(3) CURRENT IMPLEMENTATION for descriptorless and allocatable coarrays For descriptorless coarrays (scalar or array), those values are stored as language-specific type nodes (TYPE_LANG_SPECIFIC), namely: GFC_TYPE_ARRAY_CAF_TOKEN and .GFC_TYPE_ARRAY_CAF_OFFSET. For descriptorless coarray dummies (scalar or array), the token and the offset are passed as hidden dummy arguments - similar to string lengths. For allocatable coarrays (array and scalar), the cobound is transferred via additional dimension triplets and the the token is stored in the descriptor as tailing component. The token is accessible via gfc_conv_descriptor_token. THIS PATCH: Assumed-shape coarrays Assumed shape coarrays are declared as, e.g., integer :: A(:,:)[*] thus, contrary to deferred-shape/allocatable coarrays, the codimension does not need to be passed (and the corank can be differ between actual and dummy argument). However, both token and offset are important since this information is not passed. Handled by passing the token/offset as hidden argument and saving it in a lang_decl node. Tobias 2011-08-23 Tobias Burnus * trans-array.c (gfc_conv_descriptor_token): Add assert. * trans-decl.c (gfc_build_qualified_array, create_function_arglist): Handle assumed-shape arrays. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-types.c (gfc_get_array_descriptor_base): Ditto, don't add "caf_token" to assumed-shape descriptors, new akind argument. (gfc_get_array_type_bounds): Pass akind. * trans.h (lang_decl): New elements caf_offset and token. (GFC_DECL_TOKEN, GFC_DECL_CAF_OFFSET): New macros. 2011-08-23 Tobias Burnus * gfortran.dg/coarray_lib_token_4.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3a75658..c5e1940 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -277,6 +277,7 @@ gfc_conv_descriptor_token (tree desc) type = TREE_TYPE (desc); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + gcc_assert (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE); gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB); field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD); gcc_assert (field != NULL_TREE && TREE_TYPE (field) == prvoid_type_node); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cdbb375..1059a42 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -755,6 +755,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) && !sym->attr.contained; if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB + && sym->as->type != AS_ASSUMED_SHAPE && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE) { tree token; @@ -2104,12 +2105,11 @@ create_function_arglist (gfc_symbol * sym) f->sym->backend_decl = parm; - /* Coarrays which do not use a descriptor pass with -fcoarray=lib the - token and the offset as hidden arguments. */ + /* Coarrays which are descriptorless or assumed-shape pass with + -fcoarray=lib the token and the offset as hidden arguments. */ if (f->sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB - && !f->sym->attr.allocatable - && f->sym->as->type != AS_ASSUMED_SHAPE) + && !f->sym->attr.allocatable) { tree caf_type; tree token; @@ -2119,12 +2119,24 @@ create_function_arglist (gfc_symbol * sym) && !sym->attr.is_bind_c); caf_type = TREE_TYPE (f->sym->backend_decl); - gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE); token = build_decl (input_location, PARM_DECL, create_tmp_var_name ("caf_token"), build_qualified_type (pvoid_type_node, TYPE_QUAL_RESTRICT)); - GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) = token; + if (f->sym->as->type == AS_ASSUMED_SHAPE) + { + gcc_assert (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL + || GFC_DECL_TOKEN (f->sym->backend_decl) == NULL_TREE); + if (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL) + gfc_allocate_lang_decl (f->sym->backend_decl); + GFC_DECL_TOKEN (f->sym->backend_decl) = token; + } + else + { + gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE); + GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) = token; + } + DECL_CONTEXT (token) = fndecl; DECL_ARTIFICIAL (token) = 1; DECL_ARG_TYPE (token) = TREE_VALUE (typelist); @@ -2132,12 +2144,21 @@ create_function_arglist (gfc_symbol * sym) hidden_arglist = chainon (hidden_arglist, token); gfc_finish_decl (token); - gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE); offset = build_decl (input_location, PARM_DECL, create_tmp_var_name ("caf_offset"), gfc_array_index_type); - GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) = offset; + if (f->sym->as->type == AS_ASSUMED_SHAPE) + { + gcc_assert (GFC_DECL_CAF_OFFSET (f->sym->backend_decl) + == NULL_TREE); + GFC_DECL_CAF_OFFSET (f->sym->backend_decl) = offset; + } + else + { + gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE); + GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) = offset; + } DECL_CONTEXT (offset) = fndecl; DECL_ARTIFICIAL (offset) = 1; DECL_ARG_TYPE (offset) = TREE_VALUE (typelist); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 39a83ce..db8a89f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3390,11 +3390,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c) VEC_safe_push (tree, gc, stringargs, parmse.string_length); - /* For descriptorless coarrays, we pass the token and the offset - as additional arguments. */ + /* For descriptorless coarrays and assumed-shape coarray dummies, we + pass the token and the offset as additional arguments. */ if (fsym && fsym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB - && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE + && !fsym->attr.allocatable && e == NULL) { /* Token and offset. */ @@ -3404,7 +3404,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gcc_assert (fsym->attr.optional); } else if (fsym && fsym->attr.codimension - && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE + && !fsym->attr.allocatable && gfc_option.coarray == GFC_FCOARRAY_LIB) { tree caf_decl, caf_type; @@ -3413,8 +3413,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, caf_decl = get_tree_for_caf_expr (e); caf_type = TREE_TYPE (caf_decl); - if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + if (GFC_DESCRIPTOR_TYPE_P (caf_type) + && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) tmp = gfc_conv_descriptor_token (caf_decl); + else if (DECL_LANG_SPECIFIC (caf_decl) + && GFC_DECL_TOKEN (caf_decl) != NULL_TREE) + tmp = GFC_DECL_TOKEN (caf_decl); else { gcc_assert (GFC_ARRAY_TYPE_P (caf_type) @@ -3424,8 +3428,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, VEC_safe_push (tree, gc, stringargs, tmp); - if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + if (GFC_DESCRIPTOR_TYPE_P (caf_type) + && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) offset = build_int_cst (gfc_array_index_type, 0); + else if (DECL_LANG_SPECIFIC (caf_decl) + && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE) + offset = GFC_DECL_CAF_OFFSET (caf_decl); else if (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) != NULL_TREE) offset = GFC_TYPE_ARRAY_CAF_OFFSET (caf_type); else @@ -3439,7 +3447,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = caf_decl; } - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr))) + if (fsym->as->type == AS_ASSUMED_SHAPE) + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr))); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE + (TREE_TYPE (parmse.expr)))); + tmp2 = build_fold_indirect_ref_loc (input_location, parmse.expr); + tmp2 = gfc_conv_descriptor_data_get (tmp2); + } + else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr))) tmp2 = gfc_conv_descriptor_data_get (parmse.expr); else { diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index bec2a11..458e947 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1614,10 +1614,12 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, return type; } + /* Return or create the base type for an array descriptor. */ static tree -gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) +gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted, + enum gfc_array_kind akind) { tree fat_type, decl, arraytype, *chain = NULL; char name[16 + 2*GFC_RANK_DIGITS + 1 + 1]; @@ -1671,7 +1673,8 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) arraytype, &chain); TREE_NO_WARNING (decl) = 1; - if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen) + if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen + && akind == GFC_ARRAY_ALLOCATABLE) { decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("token"), @@ -1683,7 +1686,8 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) gfc_finish_type (fat_type); TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1; - if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen) + if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen + && akind == GFC_ARRAY_ALLOCATABLE) gfc_array_descriptor_base_caf[idx] = fat_type; else gfc_array_descriptor_base[idx] = fat_type; @@ -1691,6 +1695,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) return fat_type; } + /* Build an array (descriptor) type with given bounds. */ tree @@ -1703,11 +1708,11 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, const char *type_name; int n; - base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted); + base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted, akind); fat_type = build_distinct_type_copy (base_type); /* Make sure that nontarget and target array type have the same canonical type (and same stub decl for debug info). */ - base_type = gfc_get_array_descriptor_base (dimen, codimen, false); + base_type = gfc_get_array_descriptor_base (dimen, codimen, false, akind); TYPE_CANONICAL (fat_type) = base_type; TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index bb94780..0c249a6 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -750,12 +750,16 @@ struct GTY((variable_size)) lang_decl { tree stringlen; tree addr; tree span; + /* For assumed-shape coarrays. */ + tree token, caf_offset; }; #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr #define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen #define GFC_DECL_SPAN(node) DECL_LANG_SPECIFIC(node)->span +#define GFC_DECL_TOKEN(node) DECL_LANG_SPECIFIC(node)->token +#define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset #define GFC_DECL_SAVED_DESCRIPTOR(node) \ (DECL_LANG_SPECIFIC(node)->saved_descriptor) #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node) --- /dev/null 2011-08-22 07:33:18.402869820 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 2011-08-22 23:12:24.000000000 +0200 @@ -0,0 +1,53 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Check argument passing with assumed-shape coarray dummies +! +program test_caf + implicit none + integer, allocatable :: A(:)[:] + integer, save :: B(3)[*] + integer :: i + + allocate (A(3)[*]) + A = [1, 2, 3 ] + B = [9, 7, 4 ] + call foo (A, A, test=1) + call foo (A(2:3), B, test=2) + call foo (B, A, test=3) +contains + subroutine foo(x, y, test) + integer :: x(:)[*] + integer, contiguous :: y(:)[*] + integer :: test + call bar (x) + call expl (y) + end subroutine foo + + subroutine bar(y) + integer :: y(:)[*] + end subroutine bar + + subroutine expl(z) + integer :: z(*)[*] + end subroutine expl +end program test_caf + +! { dg-final { scan-tree-dump-times "expl \\(integer\\(kind=4\\).0:. . restrict z, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } } +! +! { dg-final { scan-tree-dump-times "bar \\(struct array2_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } } +! +! { dg-final { scan-tree-dump-times "foo \\(struct array2_integer\\(kind=4\\) & restrict x, struct array2_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } } +! +! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } } +! { d_g-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } } +! +! { dg-final { scan-tree-dump-times "expl \\(\\(integer\\(kind=4\\).0:. .\\) parm.\[0-9\]+.data, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(\\(integer\\(kind=.\\)\\) y.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 0 "original" } } +! +! { dg-final { scan-tree-dump-times "foo \\(&a, &a, &C.\[0-9\]+, a.token, 0, a.token, 0\\);" 1 "original" } } +! +! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &parm.\[0-9\]+, &C.\[0-9\]+, a.token, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) a.data, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) b\\);" 1 "original" } } +! +! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &a, &C.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) b, a.token, 0\\);" 1 "original" } } +! +! { dg-final { cleanup-tree-dump "original" } }