[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_pdt_array_descriptor
Mikael Morin
mikael@gcc.gnu.org
Mon Sep 15 13:56:40 GMT 2025
https://gcc.gnu.org/g:680ce9db24c39f5799c3f22db93f1ecb4cc5f1d9
commit 680ce9db24c39f5799c3f22db93f1ecb4cc5f1d9
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Thu Jul 31 12:34:22 2025 +0200
Extraction gfc_set_pdt_array_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 62 +++++------------------------------------
gcc/fortran/trans-descriptor.cc | 50 +++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
3 files changed, 59 insertions(+), 55 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 10a661e76260..9036c318a1af 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10154,56 +10154,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
if (c->attr.pdt_array)
{
- gfc_se tse;
- int i;
- tree size = gfc_index_one_node;
- tree offset = gfc_index_zero_node;
- tree lower, upper;
- gfc_expr *e;
-
- /* This chunk takes the expressions for 'lower' and 'upper'
- in the arrayspec and substitutes in the expressions for
- the parameters from 'pdt_param_list'. The descriptor
- fields can then be filled from the values so obtained. */
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)));
- for (i = 0; i < c->as->rank; i++)
- {
- gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->as->lower[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- lower = tse.expr;
- gfc_conv_descriptor_lbound_set (&fnblock, comp,
- gfc_rank_cst[i],
- lower);
- e = gfc_copy_expr (c->as->upper[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- upper = tse.expr;
- gfc_conv_descriptor_ubound_set (&fnblock, comp,
- gfc_rank_cst[i],
- upper);
- gfc_conv_descriptor_stride_set (&fnblock, comp,
- gfc_rank_cst[i],
- size);
- size = gfc_evaluate_now (size, &fnblock);
- offset = fold_build2_loc (input_location,
- MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &fnblock);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- upper, lower);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
- }
- gfc_conv_descriptor_offset_set (&fnblock, comp, offset);
+ tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
+ pdt_param_list);
+
if (c->ts.type == BT_CLASS)
{
tmp = gfc_get_vptr_from_expr (comp);
@@ -10214,18 +10167,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
else
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
tmp = fold_convert (gfc_array_index_type, tmp);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ tree size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, nelts, tmp);
size = gfc_evaluate_now (size, &fnblock);
tmp = gfc_call_malloc (&fnblock, NULL, size);
gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
- gfc_conv_descriptor_dtype_set (&fnblock, comp,
- gfc_get_dtype (ctype));
if (c->initializer && c->initializer->rank)
{
+ gfc_se tse;
gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->initializer);
+ gfc_expr *e = gfc_copy_expr (c->initializer);
gfc_insert_parameter_exprs (e, pdt_param_list);
gfc_conv_expr_descriptor (&tse, e);
gfc_add_block_to_block (&fnblock, &tse.pre);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 910fe72ea8fe..23b5186c84a7 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2412,3 +2412,53 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop,
gfc_conv_descriptor_dtype_set (block, desc,
gfc_get_dtype (TREE_TYPE (desc)));
}
+
+
+tree
+gfc_set_pdt_array_descriptor (stmtblock_t *block, tree descr,
+ gfc_array_spec *as,
+ gfc_actual_arglist *pdt_param_list)
+{
+ gfc_se tse;
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ gfc_expr *e;
+
+ /* This chunk takes the expressions for 'lower' and 'upper'
+ in the arrayspec and substitutes in the expressions for
+ the parameters from 'pdt_param_list'. The descriptor
+ fields can then be filled from the values so obtained. */
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (descr)));
+ for (int i = 0; i < as->rank; i++)
+ {
+ gfc_init_se (&tse, NULL);
+ e = gfc_copy_expr (as->lower[i]);
+ gfc_insert_parameter_exprs (e, pdt_param_list);
+ gfc_conv_expr_type (&tse, e, gfc_array_index_type);
+ gfc_free_expr (e);
+ tree lower = tse.expr;
+ gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[i], lower);
+ e = gfc_copy_expr (as->upper[i]);
+ gfc_insert_parameter_exprs (e, pdt_param_list);
+ gfc_conv_expr_type (&tse, e, gfc_array_index_type);
+ gfc_free_expr (e);
+ tree upper = tse.expr;
+ gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[i], upper);
+ gfc_conv_descriptor_stride_set (block, descr, gfc_rank_cst[i], size);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, upper, lower);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ tmp, gfc_index_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+ }
+ gfc_conv_descriptor_offset_set (block, descr, offset);
+ gfc_conv_descriptor_dtype_set (block, descr,
+ gfc_get_dtype (TREE_TYPE (descr)));
+
+ return size;
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index cc46f1fc2e17..1f1668180d63 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -145,5 +145,7 @@ void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
void gfc_set_descriptor_for_assign_realloc (stmtblock_t *, gfc_loopinfo *,
gfc_expr *, gfc_expr *, tree, tree,
tree, tree, bool);
+tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
+ gfc_actual_arglist *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
More information about the Gcc-cvs
mailing list