https://gcc.gnu.org/g:6fb9c9fb7f2487b57e88dc1760bd74d198c2843b
commit 6fb9c9fb7f2487b57e88dc1760bd74d198c2843b
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Feb 12 18:17:41 2025 +0100
Factorisation set temporary descriptor
Suppression code redondant initialisation descriptor temporaire
Réduction différences
Correction régression class_transformational_2
Diff:
---
gcc/fortran/trans-array.cc | 119 ++++++++++++++++++++++++++++-----------------
1 file changed, 74 insertions(+), 45 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e9b9084b79b6..ecffd0d5c0c6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3308,13 +3308,14 @@ gfc_set_loop_bounds_from_array_spec
(gfc_interface_mapping * mapping,
DYNAMIC is true if the caller may want to extend the array later
using realloc. This prevents us from putting the array on the stack. */
-static void
+static tree
gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
gfc_array_info * info, tree size, tree nelem,
tree initial, bool dynamic, bool dealloc)
{
tree tmp;
tree desc;
+ tree ptr = NULL_TREE;
bool onstack;
desc = info->descriptor;
@@ -3322,7 +3323,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
if (size == NULL_TREE || (dynamic && integer_zerop (size)))
{
/* A callee allocated array. */
- gfc_conv_descriptor_data_set (pre, desc, null_pointer_node);
+ ptr = null_pointer_node;
onstack = false;
}
else
@@ -3350,8 +3351,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
fold_build1_loc (input_location,
DECL_EXPR, TREE_TYPE (tmp),
tmp));
- tmp = gfc_build_addr_expr (NULL_TREE, tmp);
- gfc_conv_descriptor_data_set (pre, desc, tmp);
+ ptr = gfc_build_addr_expr (NULL_TREE, tmp);
}
else
{
@@ -3359,7 +3359,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
if (initial == NULL_TREE)
{
tmp = gfc_call_malloc (pre, NULL, size);
- tmp = gfc_evaluate_now (tmp, pre);
+ ptr = gfc_evaluate_now (tmp, pre);
}
else
{
@@ -3402,18 +3402,12 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
build_empty_stmt (input_location));
gfc_add_expr_to_block (pre, tmp);
- tmp = fold_convert (pvoid_type_node, packed);
+ ptr = fold_convert (pvoid_type_node, packed);
}
-
- gfc_conv_descriptor_data_set (pre, desc, tmp);
}
}
info->data = gfc_conv_descriptor_data_get (desc);
- /* The offset is zero because we create temporaries with a zero
- lower bound. */
- gfc_conv_descriptor_offset_set (pre, desc, gfc_index_zero_node);
-
if (dealloc && !onstack)
{
/* Free the temporary. */
@@ -3421,6 +3415,8 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (post, tmp);
}
+
+ return ptr;
}
@@ -3632,6 +3628,61 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss,
tree *eltype,
}
+static void
+set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
+ tree elemsize, tree data_ptr,
+ tree ubound[GFC_MAX_DIMENSIONS],
+ tree stride[GFC_MAX_DIMENSIONS], int rank,
+ bool callee_allocated, bool rank_changer)
+{
+ int n;
+
+ if (!class_src)
+ {
+ /* Fill in the array dtype. */
+ gfc_conv_descriptor_dtype_set (block, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
+ }
+ else if (rank_changer)
+ {
+ /* For classes, we copy the whole original class descriptor to the
+ temporary one, so we don't need to set the individual dtype fields.
+ Except for the case of rank altering intrinsics for which we
+ generate descriptors of different rank. */
+
+ /* Take the dtype from the class expression. */
+ tree src_data = gfc_class_data_get (class_src);
+ tree dtype = gfc_conv_descriptor_dtype_get (src_data);
+ gfc_conv_descriptor_dtype_set (block, desc, dtype);
+
+ /* These transformational functions change the rank. */
+ gfc_conv_descriptor_rank_set (block, desc, rank);
+ }
+
+ if (!callee_allocated)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ /* Store the stride and bound components in the descriptor. */
+ gfc_conv_descriptor_stride_set (block, desc, gfc_rank_cst[n],
+ stride[n]);
+
+ gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[n],
+ gfc_index_zero_node);
+
+ gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[n],
ubound[n]);
+ }
+ }
+
+ gfc_conv_descriptor_span_set (block, desc, elemsize);
+
+ gfc_conv_descriptor_data_set (block, desc, data_ptr);
+
+ /* The offset is zero because we create temporaries with a zero
+ lower bound. */
+ gfc_conv_descriptor_offset_set (block, desc, gfc_index_zero_node);
+}
+
/* Generate code to create and initialize the descriptor for a temporary
array. This is used for both temporaries needed by the scalarizer, and
@@ -3659,7 +3710,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
gfc_loopinfo *loop;
gfc_ss *s;
gfc_array_info *info;
- tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
+ tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS],
stride[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
tree tmp;
@@ -3795,13 +3846,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
TREE_USED (desc) = 0;
}
+ bool rank_changer = false;
if (class_expr != NULL_TREE
|| (fcn_ss && fcn_ss->info && fcn_ss->info->class_container))
{
tree class_data;
- tree dtype;
gfc_expr *expr1 = fcn_ss ? fcn_ss->info->expr : NULL;
- bool rank_changer;
/* Pick out these transformational functions because they change the rank
or shape of the first argument. This requires that the class type be
@@ -3855,18 +3905,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
class_data = gfc_class_data_get (tmp);
if (rank_changer)
- {
- /* Take the dtype from the class expression. */
- dtype = gfc_conv_descriptor_dtype_get (gfc_class_data_get
(class_expr));
- gfc_conv_descriptor_dtype_set (pre, desc, dtype);
-
- /* These transformational functions change the rank. */
- tmp = gfc_conv_descriptor_rank_get (desc);
- gfc_conv_descriptor_rank_set (pre, desc,
- build_int_cst (TREE_TYPE (tmp),
- ss->loop->dimen));
- fcn_ss->info->class_container = NULL_TREE;
- }
+ fcn_ss->info->class_container = NULL_TREE;
/* Assign the new descriptor to the _data field. This allows the
vptr _copy to be used for scalarized assignment since the class
@@ -3878,12 +3917,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
/* Point desc to the class _data field. */
desc = class_data;
}
- else
- {
- /* Fill in the array dtype. */
- gfc_conv_descriptor_dtype_set (pre, desc,
- gfc_get_dtype (TREE_TYPE (desc)));
- }
info->descriptor = desc;
size = gfc_index_one_node;
@@ -3930,13 +3963,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
for (n = 0; n < total_dim; n++)
{
- /* Store the stride and bound components in the descriptor. */
- gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
-
- gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
- gfc_index_zero_node);
-
- gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
+ stride[n] = size;
tmp = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
@@ -3977,12 +4004,14 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
size = NULL_TREE;
}
- /* Set the span. */
- tmp = fold_convert (gfc_array_index_type, elemsize);
- gfc_conv_descriptor_span_set (pre, desc, tmp);
+ tree data_ptr = gfc_trans_allocate_array_storage (pre, post, info, size,
+ nelem, initial, dynamic,
+ dealloc);
- gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
- dynamic, dealloc);
+ set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
+ to, stride, total_dim,
+ size == NULL_TREE || callee_alloc,
+ rank_changer);
while (ss->parent)
ss = ss->parent;
