https://gcc.gnu.org/g:bc16ffd1d64e963598e10fc34fa140f359f829dd
commit bc16ffd1d64e963598e10fc34fa140f359f829dd
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 | 186 ++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 7 ++
3 files changed, 198 insertions(+), 189 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0f24f098e063..5a8769f6d4fd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7297,173 +7297,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
@@ -7936,9 +7769,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;
}
@@ -8967,23 +8800,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. */
@@ -9277,7 +9093,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;
@@ -9433,7 +9249,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 51288296c827..ea4b6ba5fcad 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2872,6 +2872,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.
@@ -3176,4 +3344,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 ab199e86f123..8a03d4a43b00 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);
