[gcc(refs/users/mikael/heads/refactor_descriptor_v291 .01)] Suppression mise à jour offset forall
Mikael Morin via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:ecfbadb0de2409539cbabd20730ae26f1a73caf5 commit ecfbadb0de2409539cbabd20730ae26f1a73caf5 Author: Mikael Morin <[email protected]> Date: Mon Feb 17 17:28:01 2025 +0100 Suppression mise à jour offset forall Sauvegarde Correction régression forall Diff: --- gcc/fortran/trans-array.cc | 55 +++++++++++++++++++++++++---------------- gcc/fortran/trans-array.h | 3 ++- gcc/fortran/trans-descriptor.cc | 37 ++++++++++++++++++++++----- gcc/fortran/trans-descriptor.h | 4 ++- gcc/fortran/trans-expr.cc | 4 ++- gcc/fortran/trans-stmt.cc | 10 ++------ gcc/fortran/trans.h | 4 ++- 7 files changed, 78 insertions(+), 39 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 2b638aa322cf..d4f709584fd2 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1068,7 +1068,8 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype, tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, tree eltype, tree initial, bool dynamic, - bool dealloc, bool callee_alloc, locus * where) + bool dealloc, bool callee_alloc, locus * where, + bool shift_bounds) { gfc_loopinfo *loop; gfc_ss *s; @@ -1156,19 +1157,23 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, { dim = s->dim[n]; - /* Callee allocated arrays may not have a known bound yet. */ - if (loop->to[n]) - loop->to[n] = gfc_evaluate_now ( - fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - loop->to[n], loop->from[n]), - pre); - loop->from[n] = gfc_index_zero_node; + if (shift_bounds) + { + /* Callee allocated arrays may not have a known bound yet. */ + if (loop->to[n]) + { + tree t = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + loop->to[n], loop->from[n]); + loop->to[n] = gfc_evaluate_now (t, pre); + } + loop->from[n] = gfc_index_zero_node; - /* We have just changed the loop bounds, we must clear the - corresponding specloop, so that delta calculation is not skipped - later in gfc_set_delta. */ - loop->specloop[n] = NULL; + /* We have just changed the loop bounds, we must clear the + corresponding specloop, so that delta calculation is not + skipped later in gfc_set_delta. */ + loop->specloop[n] = NULL; + } /* We are constructing the temporary's descriptor based on the loop dimensions. As the dimensions may be accessed in arbitrary order @@ -1329,13 +1334,18 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, { stride[n] = size; - tmp = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, - to[n], gfc_index_one_node); + tmp = gfc_index_one_node; + if (!shift_bounds && !integer_zerop (from[n])) + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + gfc_index_one_node, from[n]); + + tree extent = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, to[n], tmp); /* Check whether the size for this dimension is negative. */ cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, - tmp, gfc_index_zero_node); + extent, gfc_index_zero_node); cond = gfc_evaluate_now (cond, pre); if (n == 0) @@ -1345,7 +1355,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, logical_type_node, or_expr, cond); size = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, size, tmp); + gfc_array_index_type, size, extent); size = gfc_evaluate_now (size, pre); } } @@ -1373,9 +1383,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, dealloc); gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr, - to, stride, total_dim, + from, to, stride, total_dim, size == NULL_TREE || callee_alloc, - rank_changer); + rank_changer, shift_bounds); while (ss->parent) ss = ss->parent; @@ -5854,6 +5864,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) (TREE_TYPE (tmp_ss_info->data.temp.type), tmp_ss_info->string_length); + bool preserve_bounds = tmp_ss_info->data.temp.preserve_bounds; + tmp = tmp_ss_info->data.temp.type; memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info)); tmp_ss_info->type = GFC_SS_SECTION; @@ -5861,7 +5873,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (tmp_ss->dimen != 0); gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp, - NULL_TREE, false, true, false, where); + NULL_TREE, false, true, false, where, + !preserve_bounds); } /* For array parameters we don't have loop variables, so don't calculate the diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index de08126ebac5..e83ab6a8902b 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -29,7 +29,8 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, /* Generate code to create a temporary array. */ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *, - tree, tree, bool, bool, bool, locus *); + tree, tree, bool, bool, bool, locus *, + bool shift_bounds = true); /* Generate function entry code for allocation of compiler allocated array variables. */ diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 35b1987b386d..3d27d1990042 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -2295,9 +2295,11 @@ gfc_set_gfc_from_cfi (stmtblock_t *block, stmtblock_t *block2, tree gfc_desc, void gfc_set_temporary_descriptor (stmtblock_t *block, tree descr, tree class_src, tree elemsize, tree data_ptr, + tree lbound[GFC_MAX_DIMENSIONS], tree ubound[GFC_MAX_DIMENSIONS], tree stride[GFC_MAX_DIMENSIONS], int rank, - bool callee_allocated, bool rank_changer) + bool callee_allocated, bool rank_changer, + bool shift_bounds) { if (!class_src) { @@ -2321,6 +2323,7 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree descr, tree class_src, gfc_conv_descriptor_rank_set (block, descr, rank); } + tree offset = gfc_index_zero_node; if (!callee_allocated) for (int n = 0; n < rank; n++) { @@ -2328,18 +2331,40 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree descr, tree class_src, gfc_conv_descriptor_stride_set (block, descr, gfc_rank_cst[n], stride[n]); + tree this_lbound = shift_bounds ? gfc_index_zero_node : lbound[n]; gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n], - gfc_index_zero_node); + this_lbound); + + tree this_ubound; + if (shift_bounds) + { + tree lbound_diff = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + this_lbound, lbound[n]); + this_ubound = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + ubound[n], lbound_diff); + } + else + this_ubound = ubound[n]; gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n], - ubound[n]); + this_ubound); + + if (!shift_bounds) + { + tree tmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, this_lbound, + stride[n]); + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, offset, tmp); + offset = gfc_evaluate_now (tmp, block); + } } gfc_conv_descriptor_span_set (block, descr, elemsize); - /* The offset is zero because we create temporaries with a zero - lower bound. */ - gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node); + gfc_conv_descriptor_offset_set (block, descr, offset); gfc_conv_descriptor_data_set (block, descr, data_ptr); } diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 092b9d99bc7d..042ff401cfd4 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -126,6 +126,8 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree, void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree, tree [GFC_MAX_DIMENSIONS], - tree [GFC_MAX_DIMENSIONS], int, bool, bool); + tree [GFC_MAX_DIMENSIONS], + tree [GFC_MAX_DIMENSIONS], int, bool, bool, + bool shift_bounds = true); #endif /* GFC_TRANS_DESCRIPTOR_H */ diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 10ce63767364..59a0eceed5fd 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -5430,7 +5430,8 @@ void gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77, sym_intent intent, bool formal_ptr, const gfc_symbol *fsym, const char *proc_name, - gfc_symbol *sym, bool check_contiguous) + gfc_symbol *sym, bool check_contiguous, + bool preserve_bounds) { gfc_se lse; gfc_se rse; @@ -5509,6 +5510,7 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77, ? expr->ts.u.cl->backend_decl : NULL), loop.dimen); + loop.temp_ss->info->data.temp.preserve_bounds = preserve_bounds; parmse->string_length = loop.temp_ss->info->string_length; diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 0c07ec3a1396..2c88691e4a60 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -4154,17 +4154,11 @@ forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) if (old_sym->attr.dimension) { gfc_init_se (&tse, NULL); - gfc_conv_subref_array_arg (&tse, e, 0, INTENT_IN, false); + gfc_conv_subref_array_arg (&tse, e, 0, INTENT_IN, false, + NULL, NULL, NULL, false, true); gfc_add_block_to_block (pre, &tse.pre); gfc_add_block_to_block (post, &tse.post); tse.expr = build_fold_indirect_ref_loc (input_location, tse.expr); - - if (c->expr1->ref->u.ar.type != AR_SECTION) - { - /* Use the variable offset for the temporary. */ - tmp = gfc_conv_array_offset (old_sym->backend_decl); - gfc_conv_descriptor_offset_set (pre, tse.expr, tmp); - } } else { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 6788c5dc4b5c..2ec0fb630934 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -285,6 +285,7 @@ typedef struct gfc_ss_info struct { tree type; + bool preserve_bounds; } temp; @@ -565,7 +566,8 @@ void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool, const gfc_symbol *fsym = NULL, const char *proc_name = NULL, gfc_symbol *sym = NULL, - bool check_contiguous = false); + bool check_contiguous = false, + bool preserve_bounds = false); void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);