https://gcc.gnu.org/g:fe31ce6b808d366d9d7a749d94d713a198c33017
commit fe31ce6b808d366d9d7a749d94d713a198c33017
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Dec 17 17:27:24 2024 +0100
Déplacement shift descriptor vers gfc_conv_array_parameter
Suppression variables inutilisées
Diff:
---
gcc/fortran/trans-array.cc | 61 ++++++++++++++++-------------------------
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-descriptor.cc | 48 ++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 20 +-------------
5 files changed, 76 insertions(+), 57 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d79cc8ea3a40..832e8fae8a36 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -107,40 +107,31 @@ gfc_array_dataptr_type (tree desc)
return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
}
-/* Modify a descriptor such that the lbound of a given dimension is the value
- specified. This also updates ubound and offset accordingly. */
-void
-gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
- int dim, tree new_lbound)
+static bool
+keep_descriptor_lower_bound (gfc_expr *e)
{
- tree offs, ubound, lbound, stride;
- tree diff, offs_diff;
-
- new_lbound = fold_convert (gfc_array_index_type, new_lbound);
-
- offs = gfc_conv_descriptor_offset_get (desc);
- lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
- ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
- stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
+ gfc_ref *ref;
- /* Get difference (new - old) by which to shift stuff. */
- diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- new_lbound, lbound);
+ /* Detect any array references with vector subscripts. */
+ for (ref = e->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
+ && ref->u.ar.type != AR_FULL)
+ {
+ int dim;
+ for (dim = 0; dim < ref->u.ar.dimen; dim++)
+ if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+ break;
+ if (dim < ref->u.ar.dimen)
+ break;
+ }
- /* Shift ubound and offset accordingly. This has to be done before
- updating the lbound, as they depend on the lbound expression! */
- ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- ubound, diff);
- gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
- offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- diff, stride);
- offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- offs, offs_diff);
- gfc_conv_descriptor_offset_set (block, desc, offs);
+ /* Array references with vector subscripts and non-variable
+ expressions need be converted to a one-based descriptor. */
+ if (ref || e->expr_type != EXPR_VARIABLE)
+ return false;
- /* Finally set lbound to value we want. */
- gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+ return true;
}
@@ -8565,7 +8556,7 @@ is_pointer (gfc_expr *e)
void
gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
const gfc_symbol *fsym, const char *proc_name,
- tree *size, tree *lbshift, tree *packed)
+ tree *size, bool maybe_shift, tree *packed)
{
tree ptr;
tree desc;
@@ -8802,13 +8793,9 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
stmtblock_t block;
gfc_init_block (&block);
- if (lbshift && *lbshift)
- {
- /* Apply a shift of the lbound when supplied. */
- for (int dim = 0; dim < expr->rank; ++dim)
- gfc_conv_shift_descriptor_lbound (&block, se->expr, dim,
- *lbshift);
- }
+ if (maybe_shift && !keep_descriptor_lower_bound (expr))
+ gfc_conv_shift_descriptor (&block, se->expr, expr->rank);
+
tmp = gfc_class_data_get (ctree);
if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
&& CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index ae46bcf283ff..d8f3364a2122 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -154,7 +154,7 @@ tree gfc_get_array_span (tree, gfc_expr *);
void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool, const gfc_symbol *,
- const char *, tree *, tree * = nullptr,
+ const char *, tree *, bool = false,
tree * = nullptr);
/* These work with both descriptors and descriptorless arrays. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 0c3a093eb7f5..3a72babc7be1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -795,3 +795,51 @@ gfc_set_scalar_descriptor (stmtblock_t *block, tree descr,
tree value)
gfc_conv_descriptor_span_set (block, descr,
gfc_conv_descriptor_elem_len_get (descr));
}
+
+
+/* Modify a descriptor such that the lbound of a given dimension is the value
+ specified. This also updates ubound and offset accordingly. */
+
+void
+gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
+ int dim, tree new_lbound)
+{
+ tree offs, ubound, lbound, stride;
+ tree diff, offs_diff;
+
+ new_lbound = fold_convert (gfc_array_index_type, new_lbound);
+
+ offs = gfc_conv_descriptor_offset_get (desc);
+ lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
+ ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
+ stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
+
+ /* Get difference (new - old) by which to shift stuff. */
+ diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ new_lbound, lbound);
+
+ /* Shift ubound and offset accordingly. This has to be done before
+ updating the lbound, as they depend on the lbound expression! */
+ ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ ubound, diff);
+ gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
+ offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ diff, stride);
+ offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ offs, offs_diff);
+ gfc_conv_descriptor_offset_set (block, desc, offs);
+
+ /* Finally set lbound to value we want. */
+ gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+{
+ /* Apply a shift of the lbound when supplied. */
+ for (int dim = 0; dim < rank; ++dim)
+ gfc_conv_shift_descriptor_lbound (block, desc, dim,
+ gfc_index_one_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 6315da30ab69..5449cdb32672 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -97,5 +97,7 @@ void gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol
*, gfc_expr *, tree,
void gfc_init_static_descriptor (tree descr);
void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
+void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a8b7b0ee3d5a..2d903bbb0ad8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -989,8 +989,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
stmtblock_t block;
gfc_init_block (&block);
gfc_ref *ref;
- int dim;
- tree lbshift = NULL_TREE;
/* Array refs with sections indicate, that a for a formal argument
expecting contiguous repacking needs to be done. */
@@ -1003,25 +1001,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
&& (ref || e->rank != fsym->ts.u.derived->components->as->rank))
fsym->attr.contiguous = 1;
- /* Detect any array references with vector subscripts. */
- for (ref = e->ref; ref; ref = ref->next)
- if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
- && ref->u.ar.type != AR_FULL)
- {
- for (dim = 0; dim < ref->u.ar.dimen; dim++)
- if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
- break;
- if (dim < ref->u.ar.dimen)
- break;
- }
- /* Array references with vector subscripts and non-variable
- expressions need be converted to a one-based descriptor. */
- if (ref || e->expr_type != EXPR_VARIABLE)
- lbshift = gfc_index_one_node;
-
parmse->expr = var;
gfc_conv_array_parameter (parmse, e, false, fsym, proc_name, nullptr,
- &lbshift, &packed);
+ true, &packed);
if (derived_array && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
{
