From abc2c4bf5d39f9a7a91f45317f6eadc302792d6b Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Mon, 9 Nov 2020 21:06:28 +0100 Subject: [PATCH] Some naming fixes; fix handling of coarrays which are components. gcc/fortran/ChangeLog: * resolve.c (fixup_shared_coarray_args): Symbol does not have to have a codimension. * trans-array.c (gfc_native_coarray_add_this_image_offset): Rename to... (cas_add_this_image_offset): this. (cas_array_ref): New function. (gfc_conv_ss_descriptor): Use it; use cas_add_this_image_offset. (gfc_conv_array_ref): Likewise. (gfc_native_coarray_get_allocation_type): Rename to... (gfc_cas_get_allocation_type): this. (gfc_allocate_native_coarray): Rename to... (gfc_allocate_shared_coarray): this. (gfc_array_allocate): Use new functionn names. (gfc_get_dataptr_offset): Use cas_array_ref; fix logic. * trans-array.h (gfc_native_coarray_get_allocation_type): Rename prototype to... (gfc_cas_get_allocation_type): this. (gfc_allocate_native_coarray): Rename prototype to... (gfc_allocate_shared_coarray): this. * trans-decl.c (gfc_trans_native_coarray): Rename to... (gfc_trans_shared_coarray): This. Use changed function names. (gfc_trans_native_coarray_static): Rename to... (gfc_trans_shared_coarray_static): this. (gfc_trans_native_coarray_inline): Rename to... (gfc_trans_shared_coarray_inline): this. (gfc_trans_deferred_vars): Use new function names. (gfc_create_module_variable): Use new function names. * trans-stmt.c (gfc_trans_deallocate): Likewise. --- gcc/fortran/resolve.c | 1 - gcc/fortran/trans-array.c | 71 ++++++++++++++++++++++++--------------- gcc/fortran/trans-array.h | 4 +-- gcc/fortran/trans-decl.c | 18 +++++----- gcc/fortran/trans-stmt.c | 2 +- 5 files changed, 55 insertions(+), 41 deletions(-) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d54bd5807fd5..e359c2083c45 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3614,7 +3614,6 @@ fixup_shared_coarray_args (gfc_symbol *sym, gfc_actual_arglist *actual) if (a->expr == NULL || f->sym == NULL) continue; if (a->expr->expr_type == EXPR_VARIABLE - && a->expr->symtree->n.sym->attr.codimension && f->sym->attr.codimension) { gfc_ref *r; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index af346e4ec620..28de4ba4ad07 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2962,9 +2962,8 @@ gfc_add_strides (tree expr, tree desc, int beg, int end) + sum (remaining codimension offsets) If offset is a pointer, we also need to multiply it by the size. */ static tree -gfc_native_coarray_add_this_image_offset (tree offset, tree desc, - gfc_array_ref *ar, int is_pointer, - int subtract) +cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar, + int is_pointer, int subtract) { tree tmp, off; /* Calculate the actual offset. */ @@ -2995,6 +2994,28 @@ gfc_native_coarray_add_this_image_offset (tree offset, tree desc, offset, off); } +/* Return the array ref of the coarray, NULL otherwise. */ + +static gfc_ref * +cas_array_ref (gfc_ref *ref) +{ + gcc_assert (flag_coarray = GFC_FCOARRAY_SHARED); + + for (; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY) + { + if (ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1] + == DIMEN_THIS_IMAGE + && !ref->u.ar.shared_coarray_arg) + return ref; + else + return NULL; + } + } + return NULL; +} + /* Translate expressions for the descriptor and data pointer of a SS. */ /*GCC ARRAYS*/ @@ -3040,10 +3061,12 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) /* If we have a native coarray with implied this_image (), add the appropriate offset to the data pointer. */ ref = ss_info->expr->ref; - if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->type == REF_ARRAY - && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1] - == DIMEN_THIS_IMAGE) - tmp = gfc_native_coarray_add_this_image_offset (tmp, se.expr, &ref->u.ar, 1, 1); + if (flag_coarray == GFC_FCOARRAY_SHARED) + { + gfc_ref *co_ref = cas_array_ref (ref); + if (co_ref) + tmp = cas_add_this_image_offset (tmp, se.expr,&co_ref->u.ar, 1, 1); + } /* If this is a variable or address of a variable we use it directly. Otherwise we must evaluate it now to avoid breaking dependency analysis by pulling the expressions for elemental array indices @@ -3839,7 +3862,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, } if (flag_coarray == GFC_FCOARRAY_SHARED && need_impl_this_image) - offset = gfc_native_coarray_add_this_image_offset (offset, se->expr, ar, 0, 0); + offset = cas_add_this_image_offset (offset, se->expr, ar, 0, 0); if (!integer_zerop (cst_offset)) offset = fold_build2_loc (input_location, PLUS_EXPR, @@ -5903,7 +5926,7 @@ retrieve_last_ref (gfc_ref **ref_in, gfc_ref **prev_ref_in) } int -gfc_native_coarray_get_allocation_type (gfc_symbol * sym) +gfc_cas_get_allocation_type (gfc_symbol * sym) { bool is_lock_type, is_event_type; is_lock_type = sym->ts.type == BT_DERIVED @@ -5923,7 +5946,7 @@ gfc_native_coarray_get_allocation_type (gfc_symbol * sym) } void -gfc_allocate_native_coarray (stmtblock_t *b, tree decl, tree size, int corank, +gfc_allocate_shared_coarray (stmtblock_t *b, tree decl, tree size, int corank, int alloc_type) { gfc_add_expr_to_block (b, @@ -6136,8 +6159,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, tree elem_size = size_in_bytes (gfc_get_element_type (TREE_TYPE(se->expr))); int alloc_type - = gfc_native_coarray_get_allocation_type (expr->symtree->n.sym); - gfc_allocate_native_coarray (&elseblock, se->expr, elem_size, + = gfc_cas_get_allocation_type (expr->symtree->n.sym); + gfc_allocate_shared_coarray (&elseblock, se->expr, elem_size, ref->u.ar.as->corank, alloc_type); } /* The allocatable variant takes the old pointer as first argument. */ @@ -7068,13 +7091,12 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, } /* If it's a coarray with implicit this_image, add that to the offset. */ - ref = expr->ref; - if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->type == REF_ARRAY - && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1] - == DIMEN_THIS_IMAGE - && !ref->u.ar.shared_coarray_arg) - offset = gfc_native_coarray_add_this_image_offset (offset, desc, - &ref->u.ar, 0, 1); + if (flag_coarray == GFC_FCOARRAY_SHARED) + { + gfc_ref *co_ref = cas_array_ref (expr->ref); + if (co_ref) + offset = cas_add_this_image_offset (offset, desc, &co_ref->u.ar, 0, 1); + } tmp = build_array_ref (desc, offset, NULL, NULL); @@ -7091,11 +7113,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, ref = ref->next; break; } - else if (flag_coarray == GFC_FCOARRAY_SHARED && ref->type == REF_ARRAY && - ref->u.ar.dimen_type[ref->u.ar.dimen +ref->u.ar.codimen -1] - == DIMEN_THIS_IMAGE) - tmp = gfc_native_coarray_add_this_image_offset (tmp, desc, &ref->u.ar, 0, 1); - } + } /* Calculate the offset for each subsequent subreference. */ for (; ref; ref = ref->next) @@ -7158,10 +7176,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, gfc_array_index_type, stride, itmp); stride = gfc_evaluate_now (stride, block); } - if (flag_coarray == GFC_FCOARRAY_SHARED && - ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen -1] - == DIMEN_THIS_IMAGE) - tmp = gfc_native_coarray_add_this_image_offset (tmp, desc, &ref->u.ar, 0, 1); + /* Apply the index to obtain the array element. */ tmp = gfc_build_array_ref (tmp, index, NULL); break; diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index d0b05aa2b749..66f59bb068ba 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -29,9 +29,9 @@ enum gfc_coarray_allocation_type { GFC_NCA_EVENT_COARRAY }; -int gfc_native_coarray_get_allocation_type (gfc_symbol *); +int gfc_cas_get_allocation_type (gfc_symbol *); -void gfc_allocate_native_coarray (stmtblock_t *, tree, tree, int, int); +void gfc_allocate_shared_coarray (stmtblock_t *, tree, tree, int, int); /* Allow the bounds of a loop to be set from a callee's array spec. */ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4f5b8f0fd1b7..91a5dca0c7f0 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -4666,7 +4666,7 @@ get_proc_result (gfc_symbol* sym) void -gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * sym) +gfc_trans_shared_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * sym) { tree tmp, decl; /* All unused, but needed as arguments. */ @@ -4680,7 +4680,7 @@ gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * TREE_STATIC(decl) = 1; /* Tell the library to handle arrays of locks and event types seperatly. */ - alloc_type = gfc_native_coarray_get_allocation_type (sym); + alloc_type = gfc_cas_get_allocation_type (sym); if (init) { @@ -4691,7 +4691,7 @@ gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * NULL_TREE, true, NULL, &element_size); gfc_conv_descriptor_offset_set (init, decl, offset); elem_size = size_in_bytes (gfc_get_element_type (TREE_TYPE(decl))); - gfc_allocate_native_coarray (init, decl, elem_size, sym->as->corank, + gfc_allocate_shared_coarray (init, decl, elem_size, sym->as->corank, alloc_type); } @@ -4711,23 +4711,23 @@ static void generate_coarray_constructor_function (tree *, tree *); static void -gfc_trans_native_coarray_static (gfc_symbol * sym) +gfc_trans_shared_coarray_static (gfc_symbol * sym) { tree save_fn_decl, fndecl; generate_coarray_constructor_function (&save_fn_decl, &fndecl); - gfc_trans_native_coarray (&caf_init_block, NULL, sym); + gfc_trans_shared_coarray (&caf_init_block, NULL, sym); finish_coarray_constructor_function (&save_fn_decl, &fndecl); } static void -gfc_trans_native_coarray_inline (gfc_wrapped_block * block, gfc_symbol * sym) +gfc_trans_shared_coarray_inline (gfc_wrapped_block * block, gfc_symbol * sym) { stmtblock_t init, cleanup; gfc_init_block (&init); gfc_init_block (&cleanup); - gfc_trans_native_coarray (&init, &cleanup, sym); + gfc_trans_shared_coarray (&init, &cleanup, sym); gfc_add_init_cleanup (block, gfc_finish_block (&init), gfc_finish_block (&cleanup)); } @@ -5043,7 +5043,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension) { - gfc_trans_native_coarray_inline (block, sym); + gfc_trans_shared_coarray_inline (block, sym); } else { @@ -5538,7 +5538,7 @@ gfc_create_module_variable (gfc_symbol * sym) if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension && !sym->attr.allocatable) - gfc_trans_native_coarray_static (sym); + gfc_trans_shared_coarray_static (sym); gfc_module_add_decl (cur_module, decl); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index b2bd8e6e9b72..368165e69f94 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -7339,7 +7339,7 @@ gfc_trans_deallocate (gfc_code *code) if (ref && ref->type == REF_ARRAY && ref->u.ar.codimen) { gfc_symbol *sym = expr->symtree->n.sym; - int alloc_type = gfc_native_coarray_get_allocation_type (sym); + int alloc_type = gfc_cas_get_allocation_type (sym); tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_coarray_free, 2, gfc_build_addr_expr (pvoid_type_node, se.expr), -- 2.47.2