From patchwork Fri Jul 22 21:49:51 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 106393 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 42945B6F62 for ; Sat, 23 Jul 2011 07:50:17 +1000 (EST) Received: (qmail 22440 invoked by alias); 22 Jul 2011 21:50:14 -0000 Received: (qmail 22402 invoked by uid 22791); 22 Jul 2011 21:50:11 -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 21:49:54 +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 3C1FA1E217; Fri, 22 Jul 2011 23:49:51 +0200 (CEST) Message-ID: <4E29F07F.80107@net-b.de> Date: Fri, 22 Jul 2011 23:49:51 +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: Re: [Patch, Fortran] Coarray: Add "token" to the descriptor, use it for argument passing References: <4E293385.1000507@net-b.de> In-Reply-To: <4E293385.1000507@net-b.de> 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 Tobias Burnus wrote: > 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. Handling coarray descriptors differently from noncoarray descriptors is not a good idea if one does not distinguish them for caching ... Fixed by caching them separately. Build and regtested on x86-64-linux. OK for the trunk? Tobias 2011-07-23 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. (gfc_array_descriptor_base_caf): New static variable. * trans-expr.c (gfc_conv_procedure_call): Handle token and offset when passing a descriptor coarray to a nondescriptor dummy. 2011-07-23 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..96510c2 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_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..b66941f 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -81,6 +81,7 @@ bool gfc_real16_is_float128 = false; static GTY(()) tree gfc_desc_dim_type; static GTY(()) tree gfc_max_array_element_size; static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS]; +static GTY(()) tree gfc_array_descriptor_base_caf[2 * GFC_MAX_DIMENSIONS]; /* Arrays for all integral and real kinds. We'll fill this in at runtime after the target has a chance to process command-line options. */ @@ -1623,7 +1624,13 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) int idx = 2 * (codimen + dimen - 1) + restricted; gcc_assert (codimen + dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS); - if (gfc_array_descriptor_base[idx]) + + if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen) + { + if (gfc_array_descriptor_base_caf[idx]) + return gfc_array_descriptor_base_caf[idx]; + } + else if (gfc_array_descriptor_base[idx]) return gfc_array_descriptor_base[idx]; /* Build the type node. */ @@ -1664,11 +1671,23 @@ 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; - gfc_array_descriptor_base[idx] = fat_type; + if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen) + gfc_array_descriptor_base_caf[idx] = fat_type; + else + gfc_array_descriptor_base[idx] = fat_type; + return fat_type; } --- /dev/null 2011-07-22 07:25:31.139891427 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 2011-07-22 23:06:42.000000000 +0200 @@ -0,0 +1,115 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Check whether TOKEN and OFFSET are correctly propagated +! + +! THIS PART FAILED (ICE) DUE TO TYPE SHARING + +module matrix_data + implicit none + type sparse_CSR_matrix + integer, allocatable :: a(:) + end type sparse_CSR_matrix +CONTAINS + +subroutine build_CSR_matrix(CSR) + type(sparse_CSR_matrix), intent(out) :: CSR + integer, allocatable :: CAF_begin[:] + call global_to_local_index(CAF_begin) +end subroutine build_CSR_matrix + +subroutine global_to_local_index(CAF_begin) + integer, intent(out) :: CAF_begin[*] +end subroutine global_to_local_index + +end module matrix_data + + +! DUMP TESTING + +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" } }