diff options
author | Tobias Burnus <burnus@net-b.de> | 2011-07-26 09:30:37 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-07-26 09:30:37 +0200 |
commit | af232d48a7e011bf85d12634644ce80c1ad6480d (patch) | |
tree | 7605607503ae92b280d32db1d07f72f9865b92a5 /gcc/fortran | |
parent | 335d2e3964ccd360d718bbad6c9ff616acf8e65a (diff) | |
download | gcc-af232d48a7e011bf85d12634644ce80c1ad6480d.zip gcc-af232d48a7e011bf85d12634644ce80c1ad6480d.tar.gz gcc-af232d48a7e011bf85d12634644ce80c1ad6480d.tar.bz2 |
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
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 20 | ||||
-rw-r--r-- | gcc/fortran/trans-array.h | 1 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 52 | ||||
-rw-r--r-- | gcc/fortran/trans-types.c | 23 |
5 files changed, 86 insertions, 21 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 533c28c5..9537bbf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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. 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; } |