https://gcc.gnu.org/g:5fda078f56b74fbb8ca9ccb1d88b12395bc4d5a2
commit 5fda078f56b74fbb8ca9ccb1d88b12395bc4d5a2 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 | 3 +++ gcc/fortran/trans-descriptor.cc | 26 ++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 1 + 4 files changed, 37 insertions(+), 32 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 079ed89ae10b..9d3ce7321129 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); @@ -8769,39 +8770,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 d8f3364a2122..7e3a2116cb4d 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -191,3 +191,6 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int, tree, tree, int); tree gfc_conv_array_extent_dim (tree, tree, tree*); tree gfc_conv_descriptor_size (tree, int); tree gfc_conv_descriptor_cosize (tree, int, int); + +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 cac02333ec8c..f06c097d4c2a 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -1924,3 +1924,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 c37a3abacee6..fcdb6f8b84c7 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -130,5 +130,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 */