https://gcc.gnu.org/g:50f79b9e5d62281dd1be6e2de8387ecd299d98d6
commit 50f79b9e5d62281dd1be6e2de8387ecd299d98d6
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Jan 30 21:27:40 2025 +0100
Déplacement gfc_set_gfc_from_cfi
Diff:
---
gcc/fortran/trans-array.cc | 218 +++++++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-array.h | 2 +
gcc/fortran/trans-expr.cc | 218 ---------------------------------------------
gcc/fortran/trans.h | 3 -
4 files changed, 220 insertions(+), 221 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 455c9bcd76cc..66c2932deb81 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1899,6 +1899,224 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree
lhs_desc, tree rhs_desc,
}
+void
+gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
+ stmtblock_t *conditional_block, tree gfc, tree cfi,
+ tree rank, gfc_symbol *gfc_sym,
+ bool init_static, bool contiguous_gfc, bool
contiguous_cfi)
+{
+ tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+ gfc_conv_descriptor_data_set (unconditional_block, gfc, tmp);
+
+ if (init_static)
+ {
+ /* gfc->dtype = ... (from declaration, not from cfi). */
+ tree etype = gfc_get_element_type (TREE_TYPE (gfc));
+ gfc_add_modify (unconditional_block, gfc_conv_descriptor_dtype (gfc),
+ gfc_get_dtype_rank_type (gfc_sym->as->rank, etype));
+
+ if (gfc_sym->as->type == AS_ASSUMED_RANK)
+ gfc_add_modify (unconditional_block,
+ gfc_conv_descriptor_rank (gfc), rank);
+ }
+
+ if (gfc_sym && gfc_sym->ts.type == BT_ASSUMED)
+ {
+ /* For type(*), take elem_len + dtype.type from the actual argument. */
+ gfc_add_modify (unconditional_block, gfc_conv_descriptor_elem_len (gfc),
+ gfc_get_cfi_desc_elem_len (cfi));
+ tree cond;
+ tree ctype = gfc_get_cfi_desc_type (cfi);
+ ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
+ ctype, build_int_cst (TREE_TYPE (ctype),
+ CFI_type_mask));
+ tree type = gfc_conv_descriptor_type (gfc);
+
+ /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN */
+ /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
+ build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+ build_int_cst (TREE_TYPE (type), BT_VOID));
+ tree tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+ type,
+ build_int_cst (TREE_TYPE (type),
BT_UNKNOWN));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ /* if (CFI_type_struct) BT_DERIVED else < tmp2 > */
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
+ build_int_cst (TREE_TYPE (ctype),
+ CFI_type_struct));
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+ build_int_cst (TREE_TYPE (type), BT_DERIVED));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ /* if (CFI_type_Character) BT_CHARACTER else < tmp2 > */
+ /* Note: this is kind=1, CFI_type_ucs4_char is handled in the 'else if'
+ before (see below, as generated bottom up). */
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
+ build_int_cst (TREE_TYPE (ctype),
+ CFI_type_Character));
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+ build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ /* if (CFI_type_ucs4_char) BT_CHARACTER else < tmp2 > */
+ /* Note: gfc->elem_len = cfi->elem_len/4. */
+ /* However, assuming that CFI_type_ucs4_char cannot be recovered, leave
+ gfc->elem_len == cfi->elem_len, which helps with operations which use
+ sizeof() in Fortran and cfi->elem_len in C. */
+ tmp = gfc_get_cfi_desc_type (cfi);
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
+ build_int_cst (TREE_TYPE (tmp),
+ CFI_type_ucs4_char));
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+ build_int_cst (TREE_TYPE (type), BT_CHARACTER));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ /* if (CFI_type_Complex) BT_COMPLEX + cfi->elem_len/2 else < tmp2 > */
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
+ build_int_cst (TREE_TYPE (ctype),
+ CFI_type_Complex));
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+ build_int_cst (TREE_TYPE (type), BT_COMPLEX));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real)
+ ctype else <tmp2> */
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
+ build_int_cst (TREE_TYPE (ctype),
+ CFI_type_Integer));
+ tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, ctype,
+ build_int_cst (TREE_TYPE (ctype),
+ CFI_type_Logical));
+ cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
+ cond, tmp);
+ tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, ctype,
+ build_int_cst (TREE_TYPE (ctype),
+ CFI_type_Real));
+ cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
+ cond, tmp);
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+ type, fold_convert (TREE_TYPE (type), ctype));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ gfc_add_expr_to_block (unconditional_block, tmp2);
+ }
+
+ tree elem_len;
+ if (gfc_sym)
+ /* We use gfc instead of cfi as this might be a constant. */
+ elem_len = fold_convert (gfc_array_index_type,
+ gfc_conv_descriptor_elem_len (gfc));
+ else
+ elem_len = fold_convert (gfc_array_index_type,
+ gfc_get_cfi_desc_elem_len (cfi));
+
+ if (contiguous_cfi || contiguous_gfc)
+ {
+ /* gfc->span = elem_len (either cfi->elem_len or gfc.dtype.elem_len). */
+ tmp = elem_len;
+ }
+ else
+ {
+ /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
+ ? cfi->dim[0].sm : cfi->elem_len). */
+ tree sm0 = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+ tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+ gfc_array_index_type, sm0, elem_len);
+ tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+ tmp, gfc_index_zero_node);
+ tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+ sm0, elem_len);
+ }
+ gfc_conv_descriptor_span_set (conditional_block, gfc, tmp);
+
+ /* Calculate offset + set lbound, ubound and stride. */
+ gfc_conv_descriptor_offset_set (conditional_block, gfc, gfc_index_zero_node);
+ if (gfc_sym
+ && gfc_sym->as->rank > 0
+ && !gfc_sym->attr.pointer
+ && !gfc_sym->attr.allocatable)
+ for (int i = 0; i < gfc_sym->as->rank; ++i)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL );
+ if (gfc_sym->as->lower[i])
+ {
+ gfc_conv_expr (&se, gfc_sym->as->lower[i]);
+ tmp = se.expr;
+ }
+ else
+ tmp = gfc_index_one_node;
+ gfc_add_block_to_block (conditional_block, &se.pre);
+ gfc_conv_descriptor_lbound_set (conditional_block, gfc, gfc_rank_cst[i],
+ tmp);
+ gfc_add_block_to_block (conditional_block, &se.post);
+ }
+
+ /* Loop: for (i = 0; i < rank; ++i). */
+ tree idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ /* Loop body. */
+ stmtblock_t loop_body;
+ gfc_init_block (&loop_body);
+ /* gfc->dim[i].lbound = ... */
+ if (!gfc_sym || (gfc_sym->attr.pointer || gfc_sym->attr.allocatable))
+ {
+ tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+ gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
+ }
+ else if (gfc_sym && gfc_sym->as->type == AS_ASSUMED_RANK)
+ gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx,
+ gfc_index_one_node);
+
+ /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_lbound_get (gfc, idx),
+ gfc_index_one_node);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ gfc_get_cfi_dim_extent (cfi, idx), tmp);
+ gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
+
+ if (contiguous_gfc)
+ {
+ /* gfc->dim[i].stride
+ = idx == 0 ? 1 : gfc->dim[i-1].stride * cfi->dim[i-1].extent */
+ tree cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ idx, build_zero_cst (TREE_TYPE (idx)));
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (idx),
+ idx, build_int_cst (TREE_TYPE (idx), 1));
+ tree tmp2 = gfc_get_cfi_dim_extent (cfi, tmp);
+ tmp = gfc_conv_descriptor_stride_get (gfc, tmp);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp2),
+ tmp2, tmp);
+ tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
+ gfc_index_one_node, tmp);
+ }
+ else
+ {
+ /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+ tmp = gfc_get_cfi_dim_sm (cfi, idx);
+ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_array_index_type, tmp,
+ fold_convert (gfc_array_index_type,
+ gfc_get_cfi_desc_elem_len (cfi)));
+ }
+ gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+
+ /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_stride_get (gfc, idx),
+ gfc_conv_descriptor_lbound_get (gfc, idx));
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_offset_get (gfc), tmp);
+ gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
+ /* Generate loop. */
+ gfc_simple_for_loop (conditional_block, idx, build_zero_cst (TREE_TYPE
(idx)),
+ rank, LT_EXPR, build_one_cst (TREE_TYPE (idx)),
+ gfc_finish_block (&loop_body));
+}
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 124020a53858..e415568005d6 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -151,6 +151,8 @@ tree gfc_get_scalar_to_descriptor_type (tree scalar,
symbol_attribute attr);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
symbol_attribute, bool, tree);
void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
+void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
+ gfc_symbol *, bool, bool, bool);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 205c49949626..fdd46491b946 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5822,224 +5822,6 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
#endif
-void
-gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
- stmtblock_t *conditional_block, tree gfc, tree cfi,
- tree rank, gfc_symbol *gfc_sym,
- bool init_static, bool contiguous_gfc, bool
contiguous_cfi)
-{
- tree tmp = gfc_get_cfi_desc_base_addr (cfi);
- gfc_conv_descriptor_data_set (unconditional_block, gfc, tmp);
-
- if (init_static)
- {
- /* gfc->dtype = ... (from declaration, not from cfi). */
- tree etype = gfc_get_element_type (TREE_TYPE (gfc));
- gfc_add_modify (unconditional_block, gfc_conv_descriptor_dtype (gfc),
- gfc_get_dtype_rank_type (gfc_sym->as->rank, etype));
-
- if (gfc_sym->as->type == AS_ASSUMED_RANK)
- gfc_add_modify (unconditional_block,
- gfc_conv_descriptor_rank (gfc), rank);
- }
-
- if (gfc_sym && gfc_sym->ts.type == BT_ASSUMED)
- {
- /* For type(*), take elem_len + dtype.type from the actual argument. */
- gfc_add_modify (unconditional_block, gfc_conv_descriptor_elem_len (gfc),
- gfc_get_cfi_desc_elem_len (cfi));
- tree cond;
- tree ctype = gfc_get_cfi_desc_type (cfi);
- ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
- ctype, build_int_cst (TREE_TYPE (ctype),
- CFI_type_mask));
- tree type = gfc_conv_descriptor_type (gfc);
-
- /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN */
- /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_VOID));
- tree tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type,
- build_int_cst (TREE_TYPE (type),
BT_UNKNOWN));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_struct) BT_DERIVED else < tmp2 > */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_struct));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_DERIVED));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_Character) BT_CHARACTER else < tmp2 > */
- /* Note: this is kind=1, CFI_type_ucs4_char is handled in the 'else if'
- before (see below, as generated bottom up). */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Character));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_CHARACTER));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_ucs4_char) BT_CHARACTER else < tmp2 > */
- /* Note: gfc->elem_len = cfi->elem_len/4. */
- /* However, assuming that CFI_type_ucs4_char cannot be recovered, leave
- gfc->elem_len == cfi->elem_len, which helps with operations which use
- sizeof() in Fortran and cfi->elem_len in C. */
- tmp = gfc_get_cfi_desc_type (cfi);
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp),
- CFI_type_ucs4_char));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_CHARACTER));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_Complex) BT_COMPLEX + cfi->elem_len/2 else < tmp2 > */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Complex));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
- build_int_cst (TREE_TYPE (type), BT_COMPLEX));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real)
- ctype else <tmp2> */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Integer));
- tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Logical));
- cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
- cond, tmp);
- tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Real));
- cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
- cond, tmp);
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type, fold_convert (TREE_TYPE (type), ctype));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- gfc_add_expr_to_block (unconditional_block, tmp2);
- }
-
- tree elem_len;
- if (gfc_sym)
- /* We use gfc instead of cfi as this might be a constant. */
- elem_len = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_elem_len (gfc));
- else
- elem_len = fold_convert (gfc_array_index_type,
- gfc_get_cfi_desc_elem_len (cfi));
-
- if (contiguous_cfi || contiguous_gfc)
- {
- /* gfc->span = elem_len (either cfi->elem_len or gfc.dtype.elem_len). */
- tmp = elem_len;
- }
- else
- {
- /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
- ? cfi->dim[0].sm : cfi->elem_len). */
- tree sm0 = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
- tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
- gfc_array_index_type, sm0, elem_len);
- tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
- tmp, gfc_index_zero_node);
- tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
- sm0, elem_len);
- }
- gfc_conv_descriptor_span_set (conditional_block, gfc, tmp);
-
- /* Calculate offset + set lbound, ubound and stride. */
- gfc_conv_descriptor_offset_set (conditional_block, gfc, gfc_index_zero_node);
- if (gfc_sym
- && gfc_sym->as->rank > 0
- && !gfc_sym->attr.pointer
- && !gfc_sym->attr.allocatable)
- for (int i = 0; i < gfc_sym->as->rank; ++i)
- {
- gfc_se se;
- gfc_init_se (&se, NULL );
- if (gfc_sym->as->lower[i])
- {
- gfc_conv_expr (&se, gfc_sym->as->lower[i]);
- tmp = se.expr;
- }
- else
- tmp = gfc_index_one_node;
- gfc_add_block_to_block (conditional_block, &se.pre);
- gfc_conv_descriptor_lbound_set (conditional_block, gfc, gfc_rank_cst[i],
- tmp);
- gfc_add_block_to_block (conditional_block, &se.post);
- }
-
- /* Loop: for (i = 0; i < rank; ++i). */
- tree idx = gfc_create_var (TREE_TYPE (rank), "idx");
- /* Loop body. */
- stmtblock_t loop_body;
- gfc_init_block (&loop_body);
- /* gfc->dim[i].lbound = ... */
- if (!gfc_sym || (gfc_sym->attr.pointer || gfc_sym->attr.allocatable))
- {
- tmp = gfc_get_cfi_dim_lbound (cfi, idx);
- gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
- }
- else if (gfc_sym && gfc_sym->as->type == AS_ASSUMED_RANK)
- gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx,
- gfc_index_one_node);
-
- /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_lbound_get (gfc, idx),
- gfc_index_one_node);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- gfc_get_cfi_dim_extent (cfi, idx), tmp);
- gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
-
- if (contiguous_gfc)
- {
- /* gfc->dim[i].stride
- = idx == 0 ? 1 : gfc->dim[i-1].stride * cfi->dim[i-1].extent */
- tree cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- idx, build_zero_cst (TREE_TYPE (idx)));
- tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (idx),
- idx, build_int_cst (TREE_TYPE (idx), 1));
- tree tmp2 = gfc_get_cfi_dim_extent (cfi, tmp);
- tmp = gfc_conv_descriptor_stride_get (gfc, tmp);
- tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp2),
- tmp2, tmp);
- tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
- gfc_index_one_node, tmp);
- }
- else
- {
- /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
- tmp = gfc_get_cfi_dim_sm (cfi, idx);
- tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
- gfc_array_index_type, tmp,
- fold_convert (gfc_array_index_type,
- gfc_get_cfi_desc_elem_len (cfi)));
- }
- gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
-
- /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
- tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_stride_get (gfc, idx),
- gfc_conv_descriptor_lbound_get (gfc, idx));
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- gfc_conv_descriptor_offset_get (gfc), tmp);
- gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
- /* Generate loop. */
- gfc_simple_for_loop (conditional_block, idx, build_zero_cst (TREE_TYPE
(idx)),
- rank, LT_EXPR, build_one_cst (TREE_TYPE (idx)),
- gfc_finish_block (&loop_body));
-}
-
/* Provide an interface between gfortran array descriptors and the F2018:18.4
ISO_Fortran_binding array descriptors. */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 8a72f5b84c11..e9a9c24db0cd 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -463,7 +463,6 @@ bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *,
bool);
void gfc_class_array_data_assign (stmtblock_t *, tree, tree, bool);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, tree, int, const
gfc_array_ref &);
-int gfc_descriptor_rank (tree);
void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_symbol *fsym, tree,
bool, bool, const char *, tree * = nullptr);
void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
@@ -557,8 +556,6 @@ bool gfc_expr_is_variable (gfc_expr *);
gfc_inline_intrinsic_function_p returns true. */
int gfc_is_intrinsic_libcall (gfc_expr *);
-void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
- gfc_symbol *, bool, bool, bool);
/* Used to call ordinary functions/subroutines
and procedure pointer components. */
int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
