[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_conv_shift_subarray_descriptor
Mikael Morin
mikael@gcc.gnu.org
Sat Sep 6 17:22:58 GMT 2025
https://gcc.gnu.org/g:e2e353dd9bef18993fc9df2b59b4ea97cf1f02c2
commit e2e353dd9bef18993fc9df2b59b4ea97cf1f02c2
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Tue Jul 22 11:16:59 2025 +0200
Extraction gfc_conv_shift_subarray_descriptor
Correction alloc_comp_constructor_5
Diff:
---
gcc/fortran/trans-descriptor.cc | 73 +++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 84 +++--------------------------------------
3 files changed, 80 insertions(+), 78 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 2e2345d9c35e..db9dc8c326b7 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1158,3 +1158,76 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_conv_descriptor_offset_set (block, dest, offset);
}
+
+
+void
+gfc_set_subarray_descriptor (stmtblock_t *block, tree descr, tree value,
+ gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+ if (value_expr->expr_type != EXPR_VARIABLE)
+ gfc_conv_descriptor_data_set (block, value,
+ null_pointer_node);
+
+ /* Obtain the array spec of full array references. */
+ gfc_array_spec *as;
+ if (conv_arg)
+ as = gfc_get_full_arrayspec_from_expr (conv_arg);
+ else
+ as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+ /* Shift the lbound and ubound of temporaries to being unity,
+ rather than zero, based. Always calculate the offset. */
+ gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
+ tree offset = gfc_conv_descriptor_offset_get (descr);
+ tree tmp2 = gfc_create_var (gfc_array_index_type, NULL);
+
+ for (int n = 0; n < value_expr->rank; n++)
+ {
+ tree span;
+ tree lbound;
+
+ /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
+ TODO It looks as if gfc_conv_expr_descriptor should return
+ the correct bounds and that the following should not be
+ necessary. This would simplify gfc_conv_intrinsic_bound
+ as well. */
+ if (as && as->lower[n])
+ {
+ gfc_se lbse;
+ gfc_init_se (&lbse, NULL);
+ gfc_conv_expr (&lbse, as->lower[n]);
+ gfc_add_block_to_block (block, &lbse.pre);
+ lbound = gfc_evaluate_now (lbse.expr, block);
+ }
+ else if (as && conv_arg)
+ {
+ tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+ lbound = gfc_conv_descriptor_lbound_get (tmp, gfc_rank_cst[n]);
+ }
+ else if (as)
+ lbound = gfc_conv_descriptor_lbound_get (descr, gfc_rank_cst[n]);
+ else
+ lbound = gfc_index_one_node;
+
+ lbound = fold_convert (gfc_array_index_type, lbound);
+
+ /* Shift the bounds and set the offset accordingly. */
+ tree tmp = gfc_conv_descriptor_ubound_get (descr, gfc_rank_cst[n]);
+ span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_lbound_get (descr, gfc_rank_cst[n]));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ span, lbound);
+ gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n], lbound);
+
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_lbound_get (descr,
+ gfc_rank_cst[n]),
+ gfc_conv_descriptor_stride_get (descr,
+ gfc_rank_cst[n]));
+ gfc_add_modify (block, tmp2, tmp);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ offset, tmp2);
+ gfc_conv_descriptor_offset_set (block, descr, tmp);
+ }
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 5604126273c8..2a36a6c3623a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -104,6 +104,7 @@ void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
+void gfc_set_subarray_descriptor (stmtblock_t *, tree, tree, gfc_expr *, gfc_expr *);
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,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3c5600d324a7..873f1a81893b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9462,12 +9462,7 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
{
gfc_se se;
stmtblock_t block;
- tree offset;
- int n;
tree tmp;
- tree tmp2;
- gfc_array_spec *as;
- gfc_expr *arg = NULL;
gfc_start_block (&block);
gfc_init_se (&se, NULL);
@@ -9527,84 +9522,17 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &se.post);
- if (expr->expr_type != EXPR_VARIABLE)
- gfc_conv_descriptor_data_set (&block, se.expr,
- null_pointer_node);
-
/* We need to know if the argument of a conversion function is a
variable, so that the correct lower bound can be used. */
+ gfc_expr *arg = nullptr;
if (expr->expr_type == EXPR_FUNCTION
- && expr->value.function.isym
- && expr->value.function.isym->conversion
- && expr->value.function.actual->expr
- && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
+ && expr->value.function.isym
+ && expr->value.function.isym->conversion
+ && expr->value.function.actual->expr
+ && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
arg = expr->value.function.actual->expr;
- /* Obtain the array spec of full array references. */
- if (arg)
- as = gfc_get_full_arrayspec_from_expr (arg);
- else
- as = gfc_get_full_arrayspec_from_expr (expr);
-
- /* Shift the lbound and ubound of temporaries to being unity,
- rather than zero, based. Always calculate the offset. */
- gfc_conv_descriptor_offset_set (&block, dest, gfc_index_zero_node);
- offset = gfc_conv_descriptor_offset_get (dest);
- tmp2 =gfc_create_var (gfc_array_index_type, NULL);
-
- for (n = 0; n < expr->rank; n++)
- {
- tree span;
- tree lbound;
-
- /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
- TODO It looks as if gfc_conv_expr_descriptor should return
- the correct bounds and that the following should not be
- necessary. This would simplify gfc_conv_intrinsic_bound
- as well. */
- if (as && as->lower[n])
- {
- gfc_se lbse;
- gfc_init_se (&lbse, NULL);
- gfc_conv_expr (&lbse, as->lower[n]);
- gfc_add_block_to_block (&block, &lbse.pre);
- lbound = gfc_evaluate_now (lbse.expr, &block);
- }
- else if (as && arg)
- {
- tmp = gfc_get_symbol_decl (arg->symtree->n.sym);
- lbound = gfc_conv_descriptor_lbound_get (tmp,
- gfc_rank_cst[n]);
- }
- else if (as)
- lbound = gfc_conv_descriptor_lbound_get (dest,
- gfc_rank_cst[n]);
- else
- lbound = gfc_index_one_node;
-
- lbound = fold_convert (gfc_array_index_type, lbound);
-
- /* Shift the bounds and set the offset accordingly. */
- tmp = gfc_conv_descriptor_ubound_get (dest, gfc_rank_cst[n]);
- span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- tmp, gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n]));
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- span, lbound);
- gfc_conv_descriptor_ubound_set (&block, dest,
- gfc_rank_cst[n], tmp);
- gfc_conv_descriptor_lbound_set (&block, dest,
- gfc_rank_cst[n], lbound);
-
- tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_lbound_get (dest,
- gfc_rank_cst[n]),
- gfc_conv_descriptor_stride_get (dest,
- gfc_rank_cst[n]));
- gfc_add_modify (&block, tmp2, tmp);
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- offset, tmp2);
- gfc_conv_descriptor_offset_set (&block, dest, tmp);
- }
+ gfc_set_subarray_descriptor (&block, dest, se.expr, expr, arg);
if (arg)
{
More information about the Gcc-cvs
mailing list