[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression mise à jour offset forall
Mikael Morin
mikael@gcc.gnu.org
Wed Sep 17 13:02:36 GMT 2025
https://gcc.gnu.org/g:325ea51eeae8412fb4a15d78363267ed7c03e106
commit 325ea51eeae8412fb4a15d78363267ed7c03e106
Author: Mikael Morin <mikael@gcc.gnu.org>
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 aee0351667fd..84ec10e7808c 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -960,7 +960,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;
@@ -1048,19 +1049,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
@@ -1221,13 +1226,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)
@@ -1237,7 +1247,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);
}
}
@@ -1265,9 +1275,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;
@@ -5631,6 +5641,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;
@@ -5638,7 +5650,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 8b02e331aa1a..36728ab83b94 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 1d85ab847073..7449248f4720 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2124,9 +2124,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)
{
@@ -2150,6 +2152,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++)
{
@@ -2157,18 +2160,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 3c9e99ca27a2..fb003a14cca7 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -139,6 +139,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 ce35e09cf84c..a675c0fcdb44 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5297,7 +5297,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;
@@ -5376,6 +5377,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 b525c4348916..de625b293eae 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -4139,17 +4139,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 2d4218439ad4..e3f1e6925baf 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;
@@ -564,7 +565,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 *);
More information about the Gcc-cvs
mailing list