https://gcc.gnu.org/g:c1bbbaa1242357793afced890e4ad8b9f85eff49
commit c1bbbaa1242357793afced890e4ad8b9f85eff49 Author: Mikael Morin <[email protected]> Date: Wed Jul 22 21:48:21 2026 +0200 Extraction gfc_copy_descriptor Correction artefact conflit rebase Correction de la correction Correction artefact conflit rebase Correction artefact conflit rebase Diff: --- gcc/fortran/trans-array.cc | 131 +++------------------------------------- gcc/fortran/trans-array.h | 1 + gcc/fortran/trans-descriptor.cc | 111 +++++++++++++++++++++++++++++++++- gcc/fortran/trans-descriptor.h | 1 + 4 files changed, 119 insertions(+), 125 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index e1f7f64f4770..56c378a1228f 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -896,8 +896,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]); @@ -2497,7 +2497,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 (); @@ -5702,7 +5702,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); @@ -9239,129 +9240,11 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, { /* The original descriptor may have transposed dims so we can't reuse it directly; we have to create a new one. */ - tree old_field; 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); - - if (expr->rank == -1) - { - tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); - tree stride = gfc_create_var (gfc_array_index_type, "stride"); - stmtblock_t loop_body; - - gfc_conv_descriptor_offset_set (&se->pre, new_desc, - gfc_index_zero_node); - gfc_conv_descriptor_span_set (&se->pre, new_desc, - gfc_conv_descriptor_span_get - (old_desc)); - gfc_add_modify (&se->pre, stride, gfc_index_one_node); - - gfc_init_block (&loop_body); - - old_field = gfc_conv_descriptor_lbound_get (old_desc, idx); - gfc_conv_descriptor_lbound_set (&loop_body, new_desc, idx, - old_field); - - old_field = gfc_conv_descriptor_ubound_get (old_desc, idx); - gfc_conv_descriptor_ubound_set (&loop_body, new_desc, idx, - old_field); - - gfc_conv_descriptor_stride_set (&loop_body, new_desc, idx, - stride); - - tree offset = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, stride, - gfc_conv_descriptor_lbound_get - (new_desc, idx)); - offset = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - gfc_conv_descriptor_offset_get - (new_desc), offset); - gfc_conv_descriptor_offset_set (&loop_body, new_desc, offset); - - tree extent = gfc_conv_array_extent_dim - (gfc_conv_descriptor_lbound_get (new_desc, idx), - gfc_conv_descriptor_ubound_get (new_desc, idx), - NULL); - extent = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, stride, - extent); - gfc_add_modify (&loop_body, stride, extent); - - gfc_simple_for_loop (&se->pre, idx, - build_int_cst (TREE_TYPE (idx), 0), - gfc_conv_descriptor_rank_get (old_desc), - LT_EXPR, - build_int_cst (TREE_TYPE (idx), 1), - gfc_finish_block (&loop_body)); - } - else - { - tree offset = gfc_index_zero_node; - - tree stride = gfc_index_one_node; - - for (int i = 0; i < expr->rank; i++) - { - tree dim = gfc_rank_cst[i]; - - tree lbound = gfc_conv_descriptor_lbound_get (old_desc, - dim); - lbound = gfc_evaluate_now (lbound, &se->pre); - gfc_conv_descriptor_lbound_set (&se->pre, new_desc, dim, - lbound); - - tree ubound = gfc_conv_descriptor_ubound_get (old_desc, - dim); - ubound = gfc_evaluate_now (ubound, &se->pre); - gfc_conv_descriptor_ubound_set (&se->pre, new_desc, dim, - ubound); - - gfc_conv_descriptor_stride_set (&se->pre, new_desc, dim, - stride); - - tree tmp = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - stride, lbound); - offset = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - offset, tmp); - offset = gfc_evaluate_now (offset, &se->pre); - - /* Now calculate the stride for next dimension, unless the - current dimension is the last one. */ - if (i == expr->rank - 1) - break; - - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - lbound, gfc_index_one_node); - tree extent = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - ubound, tmp); - stride = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - stride, extent); - stride = gfc_evaluate_now (stride, &se->pre); - } - - gfc_conv_descriptor_offset_set (&se->pre, new_desc, offset); - } - - 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); se->expr = gfc_build_addr_expr (NULL_TREE, new_desc); } } diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 1dde17d42b21..de08126ebac5 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -192,3 +192,4 @@ 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 89d5593b0e33..ad5687d2d610 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -895,7 +895,7 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra) void gfc_nullify_descriptor (stmtblock_t *block, tree descr) { - gfc_conv_descriptor_data_set (block, descr, null_pointer_node); + gfc_conv_descriptor_data_set (block, descr, null_pointer_node); } @@ -1360,3 +1360,112 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tmp2 = gfc_get_array_span (src, src_expr); gfc_conv_descriptor_span_set (block, dest, tmp2); } + + +void +gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr, + int rank) +{ + gfc_conv_descriptor_dtype_set (block, dest, + gfc_conv_descriptor_dtype_get (src)); + + if (rank == -1) + { + tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); + tree stride = gfc_create_var (gfc_array_index_type, "stride"); + stmtblock_t loop_body; + + gfc_conv_descriptor_offset_set (block, dest, gfc_index_zero_node); + gfc_conv_descriptor_span_set (block, dest, + gfc_conv_descriptor_span_get (src)); + gfc_add_modify (block, stride, gfc_index_one_node); + + gfc_init_block (&loop_body); + + tree old_field = gfc_conv_descriptor_lbound_get (src, idx); + gfc_conv_descriptor_lbound_set (&loop_body, dest, idx, + old_field); + + old_field = gfc_conv_descriptor_ubound_get (src, idx); + gfc_conv_descriptor_ubound_set (&loop_body, dest, idx, + old_field); + + gfc_conv_descriptor_stride_set (&loop_body, dest, idx, + stride); + + tree offset = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, + gfc_conv_descriptor_lbound_get (dest, + idx)); + offset = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + gfc_conv_descriptor_offset_get (dest), + offset); + gfc_conv_descriptor_offset_set (&loop_body, dest, offset); + + tree extent = gfc_conv_array_extent_dim + (gfc_conv_descriptor_lbound_get (dest, idx), + gfc_conv_descriptor_ubound_get (dest, idx), + NULL); + extent = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, + extent); + gfc_add_modify (&loop_body, stride, extent); + + gfc_simple_for_loop (block, idx, build_int_cst (TREE_TYPE (idx), 0), + gfc_conv_descriptor_rank_get (src), LT_EXPR, + build_int_cst (TREE_TYPE (idx), 1), + gfc_finish_block (&loop_body)); + } + else + { + tree offset = gfc_index_zero_node; + + tree stride = gfc_index_one_node; + + for (int i = 0; i < rank; i++) + { + tree dim = gfc_rank_cst[i]; + + tree lbound = gfc_conv_descriptor_lbound_get (src, dim); + lbound = gfc_evaluate_now (lbound, block); + gfc_conv_descriptor_lbound_set (block, dest, dim, lbound); + + tree ubound = gfc_conv_descriptor_ubound_get (src, dim); + ubound = gfc_evaluate_now (ubound, block); + gfc_conv_descriptor_ubound_set (block, dest, dim, ubound); + + gfc_conv_descriptor_stride_set (block, dest, dim, stride); + + tree tmp = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, lbound); + offset = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, offset, tmp); + offset = gfc_evaluate_now (offset, block); + + /* Now calculate the stride for next dimension, unless the + current dimension is the last one. */ + if (i == rank - 1) + break; + + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, lbound, + gfc_index_one_node); + tree extent = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, ubound, tmp); + stride = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, extent); + stride = gfc_evaluate_now (stride, block); + } + + gfc_conv_descriptor_offset_set (block, dest, offset); + } + + 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 a71fa69e0bd6..808007345084 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -94,6 +94,7 @@ void gfc_shift_descriptor (stmtblock_t *, tree, int, tree [GFC_MAX_DIMENSIONS], void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int); void gfc_copy_descriptor (stmtblock_t *, tree, tree, gfc_expr *, bool); +void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree, int); void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, gfc_expr *); void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, symbol_attribute,
