From patchwork Fri Jul 22 08:23:33 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 106235 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 ADF70B6F64 for ; Fri, 22 Jul 2011 18:24:00 +1000 (EST) Received: (qmail 24013 invoked by alias); 22 Jul 2011 08:23:57 -0000 Received: (qmail 23974 invoked by uid 22791); 22 Jul 2011 08:23:54 -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; Fri, 22 Jul 2011 08:23:36 +0000 Received: from [192.168.178.22] (port-92-204-19-234.dynamic.qsc.de [92.204.19.234]) by mx02.qsc.de (Postfix) with ESMTP id 4474E1E66D; Fri, 22 Jul 2011 10:23:34 +0200 (CEST) Message-ID: <4E293385.1000507@net-b.de> Date: Fri, 22 Jul 2011 10:23:33 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:5.0) Gecko/20110624 Thunderbird/5.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] Coarray: Add "token" to the descriptor, use it for argument passing 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 continues a bit the project of argument passing with -fcoarray=lib. As a reminder: The coarray communication library uniquely identifies coarrays based on the token - and it needs to know the offset between the data you want and the base address of the coarray. This patch adds a "token" element as last element in the descriptor such that is can be easily ignored when passing a descriptor to a noncoarray descriptor dummy.* The patch additionally handles passing such an array to a nondescriptor coarray dummy. Build and regtested on x86-64-linux. OK for the trunk? * * * Planned as in follow up patches: * Actually setting the "token" variable in ALLOCATE. Daniel is working on that. * Handling assumed-shape coarrays: Besides actually setting the "token", one also needs to ensure that the "offset" is properly passed. With nested assumed-shape calls, the "offset" issue also occurs when passing such a coarray to a nondescriptor coarray dummy. I am not yet sure whether this can be handled without adding another component ("caf_offset") to the descriptor or whether it can be avoided by "misusing" other fields such as offset. Tobias (*) One currently simply passes the full array, but the planned proper way is to do a cast of the following form. However, as it works as is, fixing this will be of lower priority. struct DescriptorRank * {ref-all} tmparray = (struct DescriptorRankCorank * {ref-all})&coarray; 2011-07-22 Tobias Burnus * trans-array.c (CAF_TOKEN_FIELD): New macro constant. (gfc_conv_descriptor_token): New function. * trans-array.h (gfc_conv_descriptor_token): New prototype. * trans-types.c (gfc_get_array_descriptor_base): For coarrays with -fcoarray=lib, append "void *token" to the array descriptor. * trans-expr.c (gfc_conv_procedure_call): Handle token and offset when passing a descriptor coarray to a nondescriptor dummy. 2011-07-22 Tobias Burnus * gfortran.dg/coarray_lib_token_2.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b959b36..ff059a3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -129,6 +129,7 @@ gfc_array_dataptr_type (tree desc) #define OFFSET_FIELD 1 #define DTYPE_FIELD 2 #define DIMENSION_FIELD 3 +#define CAF_TOKEN_FIELD 4 #define STRIDE_SUBFIELD 0 #define LBOUND_SUBFIELD 1 @@ -267,6 +268,24 @@ gfc_conv_descriptor_dimension (tree desc, tree dim) return tmp; } + +tree +gfc_conv_descriptor_token (tree desc) +{ + tree type; + tree field; + + type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + 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); + + return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), + desc, field, NULL_TREE); +} + + static tree gfc_conv_descriptor_stride (tree desc, tree dim) { @@ -429,6 +448,7 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, #undef OFFSET_FIELD #undef DTYPE_FIELD #undef DIMENSION_FIELD +#undef CAF_TOKEN_FIELD #undef STRIDE_SUBFIELD #undef LBOUND_SUBFIELD #undef UBOUND_SUBFIELD diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 75704ad..61f7042 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -143,6 +143,7 @@ tree gfc_conv_descriptor_dtype (tree); tree gfc_conv_descriptor_stride_get (tree, tree); tree gfc_conv_descriptor_lbound_get (tree, tree); tree gfc_conv_descriptor_ubound_get (tree, tree); +tree gfc_conv_descriptor_token (tree); void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7622910..b720e73 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3395,48 +3395,62 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (fsym && fsym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE - && (e == NULL - || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (get_tree_for_caf_expr (e))))) - /* FIXME: Remove the "||" condition when coarray descriptors have a - "token" component. This condition occurs when passing an alloc - coarray or assumed-shape dummy to an explict-shape dummy. */ + && e == NULL) { /* Token and offset. */ VEC_safe_push (tree, gc, stringargs, null_pointer_node); VEC_safe_push (tree, gc, stringargs, build_int_cst (gfc_array_index_type, 0)); - gcc_assert (fsym->attr.optional || e != NULL); /* FIXME: "||" cond. */ + gcc_assert (fsym->attr.optional); } else if (fsym && fsym->attr.codimension && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE && gfc_option.coarray == GFC_FCOARRAY_LIB) { tree caf_decl, caf_type; - tree offset; + tree offset, tmp2; caf_decl = get_tree_for_caf_expr (e); caf_type = TREE_TYPE (caf_decl); - gcc_assert (GFC_ARRAY_TYPE_P (caf_type) - && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) != NULL_TREE); + if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + tmp = gfc_conv_descriptor_token (caf_decl); + else + { + gcc_assert (GFC_ARRAY_TYPE_P (caf_type) + && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) != NULL_TREE); + tmp = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type); + } - VEC_safe_push (tree, gc, stringargs, - GFC_TYPE_ARRAY_CAF_TOKEN (caf_type)); + VEC_safe_push (tree, gc, stringargs, tmp); - if (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) != NULL_TREE) + if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + offset = build_int_cst (gfc_array_index_type, 0); + else if (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) != NULL_TREE) offset = GFC_TYPE_ARRAY_CAF_OFFSET (caf_type); else offset = build_int_cst (gfc_array_index_type, 0); - gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)) - && POINTER_TYPE_P (TREE_TYPE (parmse.expr))); + if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + tmp = gfc_conv_descriptor_data_get (caf_decl); + else + { + gcc_assert (POINTER_TYPE_P (caf_type)); + tmp = caf_decl; + } + + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr))) + tmp2 = gfc_conv_descriptor_data_get (parmse.expr); + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr))); + tmp2 = parmse.expr; + } tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - fold_convert (gfc_array_index_type, - parmse.expr), - fold_convert (gfc_array_index_type, - caf_decl)); + fold_convert (gfc_array_index_type, tmp2), + fold_convert (gfc_array_index_type, tmp)); offset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, offset, tmp); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 01587eb..8a8ab5f 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1664,6 +1664,14 @@ 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) + { + decl = gfc_add_field_to_struct_1 (fat_type, + get_identifier ("token"), + prvoid_type_node, &chain); + TREE_NO_WARNING (decl) = 1; + } + /* Finish off the type. */ gfc_finish_type (fat_type); TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1; --- /dev/null 2011-07-22 07:25:31.139891427 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 2011-07-22 09:37:41.000000000 +0200 @@ -0,0 +1,91 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Check whether TOKEN and OFFSET are correctly propagated +! + +program main + implicit none + type t + integer(4) :: a, b + end type t + integer, allocatable :: caf[:] + type(t), allocatable :: caf_dt[:] + + allocate (caf[*]) + allocate (caf_dt[*]) + + caf = 42 + caf_dt = t (1,2) + call sub (caf, caf_dt%b) + print *,caf, caf_dt%b + if (caf /= -99 .or. caf_dt%b /= -101) call abort () + call sub_opt () + call sub_opt (caf) + if (caf /= 124) call abort () +contains + + subroutine sub (x1, x2) + integer :: x1[*], x2[*] + call sub2 (x1, x2) + end subroutine sub + + subroutine sub2 (y1, y2) + integer :: y1[*], y2[*] + + print *, y1, y2 + if (y1 /= 42 .or. y2 /= 2) call abort () + y1 = -99 + y2 = -101 + end subroutine sub2 + + subroutine sub_opt (z) + integer, optional :: z[*] + if (present (z)) then + if (z /= -99) call abort () + z = 124 + end if + end subroutine sub_opt + +end program main + +! SCAN TREE DUMP AND CLEANUP +! +! PROTOTYPE 1: +! +! sub (integer(kind=4) * restrict x1, integer(kind=4) * restrict x2, +! void * restrict caf_token.4, integer(kind=8) caf_offset.5, +! void * restrict caf_token.6, integer(kind=8) caf_offset.7) +! +! { dg-final { scan-tree-dump-times "sub \\(integer.kind=4. . restrict x1, integer.kind=4. . restrict x2, 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"} } +! +! PROTOTYPE 2: +! +! sub2 (integer(kind=4) * restrict y1, integer(kind=4) * restrict y2, +! void * restrict caf_token.0, integer(kind=8) caf_offset.1, +! void * restrict caf_token.2, integer(kind=8) caf_offset.3) +! +! { dg-final { scan-tree-dump-times "sub2 \\(integer.kind=4. . restrict y1, integer.kind=4. . restrict y2, 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"} } +! +! CALL 1 +! +! sub ((integer(kind=4) *) caf.data, &((struct t * restrict) caf_dt.data)->b, +! caf.token, 0, caf_dt.token, 4); +! +! { dg-final { scan-tree-dump-times "sub \\(\[^,\]*caf.data, &\[^,\]*caf_dt.data.->b, caf.token, 0, caf_dt.token, 4\\)" 1 "original"} } +! +! sub2 ((integer(kind=4) *) x1, (integer(kind=4) *) x2, +! caf_token.4, NON_LVALUE_EXPR , +! caf_token.6, NON_LVALUE_EXPR ); +! +! { dg-final { scan-tree-dump-times "sub2 \\(\[^,\]*x1, \[^,\]*x2, caf_token.\[0-9]+, \[^,\]*caf_offset\[^,\]*, caf_token.\[0-9\]+, \[^,\]*caf_offset\[^,\]*\\)" 1 "original"} } +! +! CALL 3 +! +! { dg-final { scan-tree-dump-times "sub_opt \\(0B, 0B, 0\\)" 1 "original"} } +! +! CALL 4 +! +! { dg-final { scan-tree-dump-times "sub_opt \\(.integer.kind=4. .. caf.data, caf.token, 0\\)" 1 "original"} } +! +! { dg-final { cleanup-tree-dump "original" } }