https://gcc.gnu.org/g:30321e8074bbc57793bdf9efd6d6641e9de3bb70
commit 30321e8074bbc57793bdf9efd6d6641e9de3bb70
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 23 10:48:32 2025 +0200
Extraction gfc_copy_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 39 +++++++--------------------------------
gcc/fortran/trans-array.h | 2 ++
gcc/fortran/trans-descriptor.cc | 26 ++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
4 files changed, 36 insertions(+), 32 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bb7d9970000e..7c838a5e9664 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -788,8 +788,8 @@ innermost_ss (gfc_ss *ss)
It is different from the loop dimension in the case of a transposed array.
*/
-static int
-get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+int
+gfc_get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
{
return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
ss->dim[loop_dim]);
@@ -2367,7 +2367,7 @@ get_loop_upper_bound_for_array (gfc_ss *array, int
array_dim)
for (ss = array; ss; ss = ss->parent)
for (n = 0; n < ss->loop->dimen; n++)
- if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ if (array_dim == gfc_get_array_ref_dim_for_loop_dim (ss, n))
return &(ss->loop->to[n]);
gcc_unreachable ();
@@ -5435,7 +5435,8 @@ set_loop_bounds (gfc_loopinfo *loop)
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
+ int idx = gfc_get_array_ref_dim_for_loop_dim (loopspec[n], n);
+ mpz_set (i, cshape[idx]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
@@ -8714,39 +8715,13 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
}
else if (!ctree)
{
- tree old_field;
-
/* The original descriptor has transposed dims so we can't reuse
it directly; we have to create a new one. */
tree old_desc = tmp;
tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
- old_field = gfc_conv_descriptor_dtype_get (old_desc);
- gfc_conv_descriptor_dtype_set (&se->pre, new_desc, old_field);
-
- old_field = gfc_conv_descriptor_offset_get (old_desc);
- gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field);
-
- for (int i = 0; i < expr->rank; i++)
- {
- int idx = get_array_ref_dim_for_loop_dim (ss, i);
- old_field = gfc_conv_descriptor_dimension_get (old_desc, idx);
- gfc_conv_descriptor_dimension_set (&se->pre, new_desc, i,
- old_field);
-
- }
-
- if (flag_coarray == GFC_FCOARRAY_LIB
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (old_desc))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (old_desc))
- == GFC_ARRAY_ALLOCATABLE)
- {
- old_field = gfc_conv_descriptor_token (old_desc);
- gfc_conv_descriptor_token_set (&se->pre, new_desc,
- old_field);
- }
-
- gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
+ gfc_copy_descriptor (&se->pre, new_desc, old_desc, ptr,
+ expr->rank, ss);
se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
}
gfc_free_ss (ss);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1d737fc2efa9..66e11d9d1f16 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -189,3 +189,5 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int,
tree, tree, int);
/* Calculate extent / size of an array. */
tree gfc_conv_array_extent_dim (tree, tree, tree*);
+int gfc_get_array_ref_dim_for_loop_dim (gfc_ss *, int);
+
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 22e5cbed8a65..b36ec15f5fda 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1922,3 +1922,29 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr, tree scalar)
}
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr,
+ int rank, gfc_ss *ss)
+{
+ gfc_conv_descriptor_dtype_set (block, dest,
+ gfc_conv_descriptor_dtype_get (src));
+
+ gfc_conv_descriptor_offset_set (block, dest,
+ gfc_conv_descriptor_offset_get (src));
+
+ for (int i = 0; i < rank; i++)
+ {
+ int idx = gfc_get_array_ref_dim_for_loop_dim (ss, i);
+ tree old_field = gfc_conv_descriptor_dimension_get (src, idx);
+ gfc_conv_descriptor_dimension_set (block, dest, i, old_field);
+ }
+
+ if (flag_coarray == GFC_FCOARRAY_LIB
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src))
+ && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (src)) == GFC_ARRAY_ALLOCATABLE)
+ gfc_conv_descriptor_token_set (block, dest,
+ gfc_conv_descriptor_token (src));
+
+ gfc_conv_descriptor_data_set (block, dest, ptr);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b586b9679877..9a648a93a52d 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -131,5 +131,6 @@ void gfc_set_descriptor_from_scalar (stmtblock_t *, tree,
tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
tree, tree);
+void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree, int, gfc_ss *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
