[gcc(refs/users/mikael/heads/refactor_descriptor_v291.01)] Extraction set_descriptor_with_shape
Mikael Morin via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:075055f9af2270b7d3c31d01d89b703d230c2ce2 commit 075055f9af2270b7d3c31d01d89b703d230c2ce2 Author: Mikael Morin <[email protected]> Date: Sun Aug 17 19:28:04 2025 +0200 Extraction set_descriptor_with_shape Reindentation retour à la ligne set_descriptor_with_shape Diff: --- gcc/fortran/trans-descriptor.cc | 112 ++++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 2 + gcc/fortran/trans-intrinsic.cc | 107 ++------------------------------------ 3 files changed, 119 insertions(+), 102 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 37fa3b1f5bdc..15aa85e97295 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -1848,3 +1848,115 @@ gfc_set_contiguous_descriptor (stmtblock_t *block, tree desc, tree size, gfc_index_zero_node, size); gfc_conv_descriptor_data_set (block, desc, data_ptr); } + + +void +gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc, tree ptr, + gfc_expr *shape, gfc_expr *lower, locus *where) +{ + /* Set the span field. */ + tree tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); + tmp = fold_convert (gfc_array_index_type, tmp); + gfc_conv_descriptor_span_set (block, desc, tmp); + + /* Set data value, dtype, and offset. */ + tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)); + gfc_conv_descriptor_data_set (block, desc, fold_convert (tmp, ptr)); + gfc_conv_descriptor_dtype_set (block, desc, + gfc_get_dtype (TREE_TYPE (desc))); + + /* Start scalarization of the bounds, using the shape argument. */ + + gfc_ss *shape_ss = gfc_walk_expr (shape); + gcc_assert (shape_ss != gfc_ss_terminator); + gfc_se shapese, lowerse; + gfc_init_se (&shapese, nullptr); + gfc_ss *lower_ss = nullptr; + if (lower) + { + lower_ss = gfc_walk_expr (lower); + gcc_assert (lower_ss != gfc_ss_terminator); + gfc_init_se (&lowerse, nullptr); + } + + gfc_loopinfo loop; + gfc_init_loopinfo (&loop); + gfc_add_ss_to_loop (&loop, shape_ss); + if (lower) + gfc_add_ss_to_loop (&loop, lower_ss); + gfc_conv_ss_startstride (&loop); + gfc_conv_loop_setup (&loop, where); + gfc_mark_ss_chain_used (shape_ss, 1); + if (lower) + gfc_mark_ss_chain_used (lower_ss, 1); + + gfc_copy_loopinfo_to_se (&shapese, &loop); + shapese.ss = shape_ss; + if (lower) + { + gfc_copy_loopinfo_to_se (&lowerse, &loop); + lowerse.ss = lower_ss; + } + + tree stride = gfc_create_var (gfc_array_index_type, "stride"); + tree offset = gfc_create_var (gfc_array_index_type, "offset"); + gfc_add_modify (block, stride, gfc_index_one_node); + gfc_add_modify (block, offset, gfc_index_zero_node); + + /* Loop body. */ + stmtblock_t body; + gfc_start_scalarized_body (&loop, &body); + + tree dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + loop.loopvar[0], loop.from[0]); + + tree lbound; + if (lower) + { + gfc_conv_expr (&lowerse, lower); + gfc_add_block_to_block (&body, &lowerse.pre); + lbound = fold_convert (gfc_array_index_type, lowerse.expr); + gfc_add_block_to_block (&body, &lowerse.post); + } + else + lbound = gfc_index_one_node; + + /* Set bounds and stride. */ + gfc_conv_descriptor_lbound_set (&body, desc, dim, lbound); + gfc_conv_descriptor_stride_set (&body, desc, dim, stride); + + gfc_conv_expr (&shapese, shape); + gfc_add_block_to_block (&body, &shapese.pre); + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + lbound, gfc_index_one_node); + tree ubound = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, + fold_convert (gfc_array_index_type, + shapese.expr)); + gfc_conv_descriptor_ubound_set (&body, desc, dim, ubound); + gfc_add_block_to_block (&body, &shapese.post); + + /* Calculate offset. */ + tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + stride, lbound); + gfc_add_modify (&body, offset, + fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, offset, tmp)); + + /* Update stride. */ + gfc_add_modify (&body, stride, + fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride, + fold_convert (gfc_array_index_type, + shapese.expr))); + /* Finish scalarization loop. */ + gfc_trans_scalarizing_loops (&loop, &body); + gfc_add_block_to_block (block, &loop.pre); + gfc_add_block_to_block (block, &loop.post); + gfc_cleanup_loop (&loop); + + gfc_add_modify (block, offset, + fold_build1_loc (input_location, NEGATE_EXPR, + gfc_array_index_type, offset)); + gfc_conv_descriptor_offset_set (block, desc, offset); +} diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index d43489346e31..d16c769abe5f 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -115,5 +115,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr, bool unlimited_polymorphic, bool data_needed, bool subref); void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree); +void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree, + gfc_expr *, gfc_expr *, locus *); #endif /* GFC_TRANS_DESCRIPTOR_H */ diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 5e3681da4675..6a3145e0045c 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -10137,11 +10137,9 @@ static tree conv_isocbinding_subroutine (gfc_code *code) { gfc_expr *cptr, *fptr, *shape, *lower; - gfc_se se, cptrse, fptrse, shapese, lowerse; - gfc_ss *shape_ss, *lower_ss; - tree desc, dim, tmp, stride, offset, lbound, ubound; - stmtblock_t body, block; - gfc_loopinfo loop; + gfc_se se, cptrse, fptrse; + tree desc; + stmtblock_t block; gfc_actual_arglist *arg; arg = code->ext.actual; @@ -10183,105 +10181,10 @@ conv_isocbinding_subroutine (gfc_code *code) gfc_add_block_to_block (&block, &fptrse.pre); desc = fptrse.expr; - /* Set the span field. */ - tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc))); - tmp = fold_convert (gfc_array_index_type, tmp); - gfc_conv_descriptor_span_set (&block, desc, tmp); - - /* Set data value, dtype, and offset. */ - tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)); - gfc_conv_descriptor_data_set (&block, desc, fold_convert (tmp, cptrse.expr)); - gfc_conv_descriptor_dtype_set (&block, desc, - gfc_get_dtype (TREE_TYPE (desc))); - - /* Start scalarization of the bounds, using the shape argument. */ - - shape_ss = gfc_walk_expr (shape); - gcc_assert (shape_ss != gfc_ss_terminator); - gfc_init_se (&shapese, NULL); - if (lower) - { - lower_ss = gfc_walk_expr (lower); - gcc_assert (lower_ss != gfc_ss_terminator); - gfc_init_se (&lowerse, NULL); - } - - gfc_init_loopinfo (&loop); - gfc_add_ss_to_loop (&loop, shape_ss); - if (lower) - gfc_add_ss_to_loop (&loop, lower_ss); - gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &fptr->where); - gfc_mark_ss_chain_used (shape_ss, 1); - if (lower) - gfc_mark_ss_chain_used (lower_ss, 1); - - gfc_copy_loopinfo_to_se (&shapese, &loop); - shapese.ss = shape_ss; - if (lower) - { - gfc_copy_loopinfo_to_se (&lowerse, &loop); - lowerse.ss = lower_ss; - } + gfc_set_descriptor_with_shape (&block, desc, cptrse.expr, shape, lower, + &fptr->where); - stride = gfc_create_var (gfc_array_index_type, "stride"); - offset = gfc_create_var (gfc_array_index_type, "offset"); - gfc_add_modify (&block, stride, gfc_index_one_node); - gfc_add_modify (&block, offset, gfc_index_zero_node); - - /* Loop body. */ - gfc_start_scalarized_body (&loop, &body); - - dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - loop.loopvar[0], loop.from[0]); - - if (lower) - { - gfc_conv_expr (&lowerse, lower); - gfc_add_block_to_block (&body, &lowerse.pre); - lbound = fold_convert (gfc_array_index_type, lowerse.expr); - gfc_add_block_to_block (&body, &lowerse.post); - } - else - lbound = gfc_index_one_node; - - /* Set bounds and stride. */ - gfc_conv_descriptor_lbound_set (&body, desc, dim, lbound); - gfc_conv_descriptor_stride_set (&body, desc, dim, stride); - - gfc_conv_expr (&shapese, shape); - gfc_add_block_to_block (&body, &shapese.pre); - ubound = fold_build2_loc ( - input_location, MINUS_EXPR, gfc_array_index_type, - fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, lbound, - fold_convert (gfc_array_index_type, shapese.expr)), - gfc_index_one_node); - gfc_conv_descriptor_ubound_set (&body, desc, dim, ubound); - gfc_add_block_to_block (&body, &shapese.post); - - /* Calculate offset. */ - tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - stride, lbound); - gfc_add_modify (&body, offset, - fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, offset, tmp)); - - /* Update stride. */ - gfc_add_modify ( - &body, stride, - fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, stride, - fold_convert (gfc_array_index_type, shapese.expr))); - /* Finish scalarization loop. */ - gfc_trans_scalarizing_loops (&loop, &body); - gfc_add_block_to_block (&block, &loop.pre); - gfc_add_block_to_block (&block, &loop.post); gfc_add_block_to_block (&block, &fptrse.post); - gfc_cleanup_loop (&loop); - - gfc_add_modify (&block, offset, - fold_build1_loc (input_location, NEGATE_EXPR, - gfc_array_index_type, offset)); - gfc_conv_descriptor_offset_set (&block, desc, offset); gfc_add_expr_to_block (&se.pre, gfc_finish_block (&block)); gfc_add_block_to_block (&se.pre, &se.post);