trans-array.c (CAF_TOKEN_FIELD): New macro constant.
2011-07-26 Tobias Burnus <burnus@net-b.de> * 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-26 Tobias Burnus <burnus@net-b.de> * gfortran.dg/coarray_lib_token_2.f90: New. From-SVN: r176784
This commit is contained in:
parent
335d2e3964
commit
af232d48a7
|
@ -1,3 +1,14 @@
|
|||
2011-07-26 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* 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 <burnus@net-b.de>
|
||||
|
||||
* resolve.c (resolve_symbol): Fix coarray var decl check.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2011-07-26 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* gfortran.dg/coarray_lib_token_2.f90: New.
|
||||
|
||||
2011-07-26 Ira Rosen <ira.rosen@linaro.org>
|
||||
|
||||
* gcc.dg/vect/vect-70.c: Reduce the data size to fit
|
||||
|
|
|
@ -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_offset.5>,
|
||||
! caf_token.6, NON_LVALUE_EXPR <caf_offset.7>);
|
||||
!
|
||||
! { 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" } }
|
Loading…
Reference in New Issue