https://gcc.gnu.org/g:0f799e46b4ff16970f4c81abd0c30fef8820a78f
commit 0f799e46b4ff16970f4c81abd0c30fef8820a78f
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sat Mar 15 16:52:01 2025 +0100
Déplacement fonctions supplémentaires
Diff:
---
gcc/fortran/trans-array.cc | 194 ++--------------------------------------
gcc/fortran/trans-descriptor.cc | 187 ++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 7 ++
3 files changed, 199 insertions(+), 189 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index de19b077f2f6..fe79e9c2e14b 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7415,173 +7415,6 @@ is_explicit_coarray (gfc_expr *expr)
}
-static void
-set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
- int rank, int corank, gfc_ss *ss, gfc_array_info *info,
- tree lowers[GFC_MAX_DIMENSIONS],
- tree uppers[GFC_MAX_DIMENSIONS],
- bool data_needed, bool subref)
-{
- int ndim = info->ref ? info->ref->u.ar.dimen : rank;
-
- /* Set the span field. */
- tree tmp = NULL_TREE;
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
- tmp = gfc_conv_descriptor_span_get (src);
- else
- tmp = gfc_get_array_span (src, src_expr);
- if (tmp)
- gfc_conv_descriptor_span_set (block, dest, tmp);
-
- /* The following can be somewhat confusing. We have two
- descriptors, a new one and the original array.
- {dest, parmtype, dim} refer to the new one.
- {src, type, n, loop} refer to the original, which maybe
- a descriptorless array.
- The bounds of the scalarization are the bounds of the section.
- We don't have to worry about numeric overflows when calculating
- the offsets because all elements are within the array data. */
-
- /* Set the dtype. */
- tree dtype;
- if (src_expr->ts.type == BT_ASSUMED)
- {
- tree tmp2 = src;
- if (DECL_LANG_SPECIFIC (tmp2) && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
- tmp2 = GFC_DECL_SAVED_DESCRIPTOR (tmp2);
- if (POINTER_TYPE_P (TREE_TYPE (tmp2)))
- tmp2 = build_fold_indirect_ref_loc (input_location, tmp2);
- dtype = gfc_conv_descriptor_dtype_get (tmp2);
- }
- else
- dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
- gfc_conv_descriptor_dtype_set (block, dest, dtype);
-
- /* The 1st element in the section. */
- tree base = gfc_index_zero_node;
- if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
- base = gfc_index_one_node;
-
- /* The offset from the 1st element in the section. */
- tree offset = gfc_index_zero_node;
-
- for (int n = 0; n < ndim; n++)
- {
- tree stride = gfc_conv_array_stride (src, n);
-
- /* Work out the 1st element in the section. */
- tree start;
- if (info->ref
- && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
- {
- gcc_assert (info->subscript[n]
- && info->subscript[n]->info->type == GFC_SS_SCALAR);
- start = info->subscript[n]->info->data.scalar.value;
- }
- else
- {
- /* Evaluate and remember the start of the section. */
- start = info->start[n];
- stride = gfc_evaluate_now (stride, block);
- }
-
- tmp = gfc_conv_array_lbound (src, n);
- tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
- start, tmp);
- tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
- tmp, stride);
- base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
- base, tmp);
-
- if (info->ref
- && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
- {
- /* For elemental dimensions, we only need the 1st
- element in the section. */
- continue;
- }
-
- /* Vector subscripts need copying and are handled elsewhere. */
- if (info->ref)
- gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_RANGE);
-
- /* look for the corresponding scalarizer dimension: dim. */
- int dim;
- for (dim = 0; dim < ndim; dim++)
- if (ss->dim[dim] == n)
- break;
-
- /* loop exited early: the DIM being looked for has been found. */
- gcc_assert (dim < ndim);
-
- /* Set the new lower bound. */
- tree from = lowers[dim];
- tree to = uppers[dim];
-
- gfc_conv_descriptor_lbound_set (block, dest,
- gfc_rank_cst[dim], from);
-
- /* Set the new upper bound. */
- gfc_conv_descriptor_ubound_set (block, dest,
- gfc_rank_cst[dim], to);
-
- /* Multiply the stride by the section stride to get the
- total stride. */
- stride = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type,
- stride, info->stride[n]);
-
- tmp = fold_build2_loc (input_location, MULT_EXPR,
- TREE_TYPE (offset), stride, from);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- TREE_TYPE (offset), offset, tmp);
-
- /* Store the new stride. */
- gfc_conv_descriptor_stride_set (block, dest,
- gfc_rank_cst[dim], stride);
- }
-
- for (int n = rank; n < rank + corank; n++)
- {
- tree from = lowers[n];
- tree to = uppers[n];
- gfc_conv_descriptor_lbound_set (block, dest,
- gfc_rank_cst[n], from);
- if (n < rank + corank - 1)
- gfc_conv_descriptor_ubound_set (block, dest,
- gfc_rank_cst[n], to);
- }
-
- if (data_needed)
- /* Point the data pointer at the 1st element in the section. */
- gfc_get_dataptr_offset (block, dest, src, base,
- subref, src_expr);
- else
- gfc_conv_descriptor_data_set (block, dest,
- gfc_index_zero_node);
-
- gfc_conv_descriptor_offset_set (block, dest, offset);
-
- if (flag_coarray == GFC_FCOARRAY_LIB && src_expr->corank)
- {
- tmp = INDIRECT_REF_P (src) ? TREE_OPERAND (src, 0) : src;
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
- {
- tmp = gfc_conv_descriptor_token_get (tmp);
- }
- else if (DECL_P (tmp) && DECL_LANG_SPECIFIC (tmp)
- && GFC_DECL_TOKEN (tmp) != NULL_TREE)
- tmp = GFC_DECL_TOKEN (tmp);
- else
- {
- tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
- }
-
- gfc_conv_descriptor_token_set (block, dest, tmp);
- }
-}
-
-
/* Convert an array for passing as an actual argument. Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed. For whole arrays the descriptor is passed. For array sections
@@ -8046,9 +7879,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gfc_get_array_span (desc, expr)));
}
- set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
- ss, info, loop.from, loop.to,
- !se->data_not_needed, subref_array_target);
+ gfc_set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
+ ss, info, loop.from, loop.to, !se->data_not_needed,
+ subref_array_target);
desc = parm;
}
@@ -9077,23 +8910,6 @@ gfc_caf_is_dealloc_only (int caf_mode)
}
-static void
-set_contiguous_array (stmtblock_t *block, tree desc, tree size, tree data_ptr)
-{
- tree dtype_value = gfc_get_dtype_rank_type (1, TREE_TYPE (desc));
- gfc_conv_descriptor_dtype_set (block, desc, dtype_value);
- gfc_conv_descriptor_lbound_set (block, desc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_stride_set (block, desc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (block, desc,
- gfc_index_zero_node, size);
- gfc_conv_descriptor_data_set (block, desc, data_ptr);
-}
-
-
/* Recursively traverse an object of derived type, generating code to
deallocate, nullify or copy allocatable components. This is the work horse
function for the functions named in this enum. */
@@ -9387,7 +9203,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
cdesc = gfc_create_var (cdesc, "cdesc");
DECL_ARTIFICIAL (cdesc) = 1;
- set_contiguous_array (&tmpblock, cdesc, ubound, comp);
+ gfc_set_contiguous_array (&tmpblock, cdesc, ubound, comp);
}
else
cdesc = comp;
@@ -9543,7 +9359,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
if (attr->dimension)
comp = gfc_conv_descriptor_data_get (comp);
- set_contiguous_array (&dealloc_block, cdesc, ubound, comp);
+ gfc_set_contiguous_array (&dealloc_block, cdesc, ubound, comp);
/* Now call the deallocator. */
vtab = gfc_find_vtab (&c->ts);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f89e4080a7dc..951a4fbacc2f 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2893,6 +2893,174 @@ gfc_conv_descriptor_cosize (tree desc, int rank, int
corank)
}
+void
+gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr
*src_expr,
+ int rank, int corank, gfc_ss *ss, gfc_array_info *info,
+ tree lowers[GFC_MAX_DIMENSIONS],
+ tree uppers[GFC_MAX_DIMENSIONS], bool data_needed,
+ bool subref)
+{
+ int ndim = info->ref ? info->ref->u.ar.dimen : rank;
+
+ /* Set the span field. */
+ tree tmp = NULL_TREE;
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
+ tmp = gfc_conv_descriptor_span_get (src);
+ else
+ tmp = gfc_get_array_span (src, src_expr);
+ if (tmp)
+ gfc_conv_descriptor_span_set (block, dest, tmp);
+
+ /* The following can be somewhat confusing. We have two
+ descriptors, a new one and the original array.
+ {dest, parmtype, dim} refer to the new one.
+ {src, type, n, loop} refer to the original, which maybe
+ a descriptorless array.
+ The bounds of the scalarization are the bounds of the section.
+ We don't have to worry about numeric overflows when calculating
+ the offsets because all elements are within the array data. */
+
+ /* Set the dtype. */
+ tree dtype;
+ if (src_expr->ts.type == BT_ASSUMED)
+ {
+ tree tmp2 = src;
+ if (DECL_LANG_SPECIFIC (tmp2) && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
+ tmp2 = GFC_DECL_SAVED_DESCRIPTOR (tmp2);
+ if (POINTER_TYPE_P (TREE_TYPE (tmp2)))
+ tmp2 = build_fold_indirect_ref_loc (input_location, tmp2);
+ dtype = gfc_conv_descriptor_dtype_get (tmp2);
+ }
+ else
+ dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
+ gfc_conv_descriptor_dtype_set (block, dest, dtype);
+
+ /* The 1st element in the section. */
+ tree base = gfc_index_zero_node;
+ if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
+ base = gfc_index_one_node;
+
+ /* The offset from the 1st element in the section. */
+ tree offset = gfc_index_zero_node;
+
+ for (int n = 0; n < ndim; n++)
+ {
+ tree stride = gfc_conv_array_stride (src, n);
+
+ /* Work out the 1st element in the section. */
+ tree start;
+ if (info->ref
+ && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+ {
+ gcc_assert (info->subscript[n]
+ && info->subscript[n]->info->type == GFC_SS_SCALAR);
+ start = info->subscript[n]->info->data.scalar.value;
+ }
+ else
+ {
+ /* Evaluate and remember the start of the section. */
+ start = info->start[n];
+ stride = gfc_evaluate_now (stride, block);
+ }
+
+ tmp = gfc_conv_array_lbound (src, n);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
+ start, tmp);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
+ tmp, stride);
+ base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+ base, tmp);
+
+ if (info->ref
+ && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+ {
+ /* For elemental dimensions, we only need the 1st
+ element in the section. */
+ continue;
+ }
+
+ /* Vector subscripts need copying and are handled elsewhere. */
+ if (info->ref)
+ gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_RANGE);
+
+ /* look for the corresponding scalarizer dimension: dim. */
+ int dim;
+ for (dim = 0; dim < ndim; dim++)
+ if (ss->dim[dim] == n)
+ break;
+
+ /* loop exited early: the DIM being looked for has been found. */
+ gcc_assert (dim < ndim);
+
+ /* Set the new lower bound. */
+ tree from = lowers[dim];
+ tree to = uppers[dim];
+
+ gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[dim], from);
+
+ /* Set the new upper bound. */
+ gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[dim], to);
+
+ /* Multiply the stride by the section stride to get the
+ total stride. */
+ stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type,
+ stride, info->stride[n]);
+
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ TREE_TYPE (offset), stride, from);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ TREE_TYPE (offset), offset, tmp);
+
+ /* Store the new stride. */
+ gfc_conv_descriptor_stride_set (block, dest,
+ gfc_rank_cst[dim], stride);
+ }
+
+ for (int n = rank; n < rank + corank; n++)
+ {
+ tree from = lowers[n];
+ tree to = uppers[n];
+ gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[n], from);
+ if (n < rank + corank - 1)
+ gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[n], to);
+ }
+
+ if (data_needed)
+ /* Point the data pointer at the 1st element in the section. */
+ gfc_get_dataptr_offset (block, dest, src, base,
+ subref, src_expr);
+ else
+ gfc_conv_descriptor_data_set (block, dest,
+ gfc_index_zero_node);
+
+ gfc_conv_descriptor_offset_set (block, dest, offset);
+
+ if (flag_coarray == GFC_FCOARRAY_LIB && src_expr->corank)
+ {
+ tmp = INDIRECT_REF_P (src) ? TREE_OPERAND (src, 0) : src;
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ {
+ tmp = gfc_conv_descriptor_token_get (tmp);
+ }
+ else if (DECL_P (tmp) && DECL_LANG_SPECIFIC (tmp)
+ && GFC_DECL_TOKEN (tmp) != NULL_TREE)
+ tmp = GFC_DECL_TOKEN (tmp);
+ else
+ {
+ tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
+ }
+
+ gfc_conv_descriptor_token_set (block, dest, tmp);
+ }
+}
+
+
+
/* Fills in an array descriptor, and returns the number of elements in the
array. The pointer argument overflow, which should be of integer type,
will increase in value if overflow occurs during the size calculation.
@@ -3197,3 +3365,22 @@ gfc_copy_descriptor_info (stmtblock_t *block, tree src,
tree dest, int rank,
}
+void
+gfc_set_contiguous_array (stmtblock_t *block, tree desc, tree size,
+ tree data_ptr)
+{
+ tree dtype_value = gfc_get_dtype_rank_type (1, TREE_TYPE (desc));
+ gfc_conv_descriptor_dtype_set (block, desc, dtype_value);
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_index_zero_node,
+ gfc_index_one_node);
+ gfc_conv_descriptor_stride_set (block, desc,
+ gfc_index_zero_node,
+ gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_index_zero_node, size);
+ gfc_conv_descriptor_data_set (block, desc, data_ptr);
+}
+
+
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 190b19bb460b..61e8e0241837 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -93,10 +93,17 @@ void gfc_set_temporary_descriptor (stmtblock_t *, tree,
tree, tree, tree,
tree[GFC_MAX_DIMENSIONS],
tree[GFC_MAX_DIMENSIONS],
tree[GFC_MAX_DIMENSIONS], int, bool, bool,
bool);
+void gfc_set_descriptor (stmtblock_t *, tree, tree, gfc_expr *, int, int,
+ gfc_ss *, gfc_array_info *, tree [GFC_MAX_DIMENSIONS],
+ tree [GFC_MAX_DIMENSIONS], bool, bool);
+
tree gfc_descr_init_count (tree, int, int, gfc_expr **, gfc_expr **,
stmtblock_t *, stmtblock_t *, tree *, tree,
gfc_expr *, tree, bool, gfc_expr *, tree, bool,
tree *);
void
gfc_copy_descriptor_info (stmtblock_t *, tree, tree, int, gfc_ss *);
+void
+gfc_set_contiguous_array (stmtblock_t *block, tree desc, tree size,
+ tree data_ptr);
