https://gcc.gnu.org/g:136efc59df2d450bae5be17d45599179ff159caf
commit 136efc59df2d450bae5be17d45599179ff159caf
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 23 14:59:35 2025 +0200
Extraction gfc_shift_descriptor
Diff:
---
gcc/fortran/trans-descriptor.cc | 32 ++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 39 ++-------------------------------------
3 files changed, 36 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 5905bd668937..68e659e07f5f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1238,3 +1238,35 @@ gfc_set_subarray_descriptor (stmtblock_t *block, tree
descr, tree value,
gfc_conv_descriptor_offset_set (block, descr, tmp);
}
}
+
+
+void
+gfc_shift_descriptor (stmtblock_t *block, tree descr, int rank,
+ tree lbound[GFC_MAX_DIMENSIONS],
+ tree ubound[GFC_MAX_DIMENSIONS])
+{
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ for (int n = 0; n < rank; n++)
+ {
+ tree tmp = gfc_conv_descriptor_ubound_get (descr, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp,
+ gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n],
+ gfc_index_one_node);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, ubound[n], lbound[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, gfc_index_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+ }
+
+ gfc_conv_descriptor_offset_set (block, descr, offset);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b1575f5a40f7..a01b02341fbf 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -108,6 +108,8 @@ void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree,
int, tree);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
void gfc_set_subarray_descriptor (stmtblock_t *, tree, tree, gfc_expr *,
gfc_expr *);
+void gfc_shift_descriptor (stmtblock_t *, tree, int, tree [GFC_MAX_DIMENSIONS],
+ tree [GFC_MAX_DIMENSIONS]);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4aa9f0b6f58a..ea03582f18b2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5327,7 +5327,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
tree tmp_index;
tree tmp;
tree base_type;
- tree size;
stmtblock_t body;
int n;
int dimen;
@@ -5568,42 +5567,8 @@ class_array_fcn:
/* Determine the offset for pointer formal arguments and set the
lbounds to one. */
if (formal_ptr)
- {
- size = gfc_index_one_node;
- offset = gfc_index_zero_node;
- for (n = 0; n < dimen; n++)
- {
- tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
- gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, tmp,
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- tmp);
- gfc_conv_descriptor_lbound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- gfc_index_one_node);
- size = gfc_evaluate_now (size, &parmse->pre);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &parmse->pre);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- rse.loop->to[n], rse.loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
- }
-
- gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
- offset);
- }
+ gfc_shift_descriptor (&parmse->pre, parmse->expr, dimen,
+ rse.loop->from, rse.loop->to);
/* We want either the address for the data or the address of the descriptor,
depending on the mode of passing array arguments. */
