https://gcc.gnu.org/g:903240f6ccbaa616eb680251351d63829beabfb6
commit 903240f6ccbaa616eb680251351d63829beabfb6
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Mon Feb 10 19:24:59 2025 +0100
Introduction getters et setters descriptor compil' OK
Correction régression realloc on assign (associate_61, ...)
Correction régression assumed_rank_7.f90
Correction ICE coarray_42.f90
Diff:
---
gcc/fortran/trans-array.cc | 817 +++++++++++++++++++++++++++++------------
gcc/fortran/trans-array.h | 26 +-
gcc/fortran/trans-decl.cc | 8 +-
gcc/fortran/trans-expr.cc | 66 ++--
gcc/fortran/trans-intrinsic.cc | 61 ++-
gcc/fortran/trans-openmp.cc | 2 +-
gcc/fortran/trans-stmt.cc | 7 +-
gcc/fortran/trans.cc | 7 +-
8 files changed, 671 insertions(+), 323 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5fcac2a39fdf..fbbbab9c1d92 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -242,8 +242,15 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
-static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
+
+namespace gfc_descriptor
+{
+
+namespace
+{
+
+tree
+get_field (tree desc, unsigned field_idx)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -251,111 +258,119 @@ gfc_get_descriptor_field (tree desc, unsigned field_idx)
tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
gcc_assert (field != NULL_TREE);
+ return field;
+}
+
+tree
+get_component (tree desc, unsigned field_idx)
+{
+ tree field = get_field (desc, field_idx);
+
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
}
-/* This provides READ-ONLY access to the data field. The field itself
- doesn't have the proper type. */
+tree
+get_data (tree desc)
+{
+ return get_component (desc, DATA_FIELD);
+}
tree
-gfc_conv_descriptor_data_get (tree desc)
+conv_data_get (tree desc)
{
tree type = TREE_TYPE (desc);
- if (TREE_CODE (type) == REFERENCE_TYPE)
- gcc_unreachable ();
+ gcc_assert (TREE_CODE (type) != REFERENCE_TYPE);
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
- return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+ tree field = get_data (desc);
+ tree t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+ return non_lvalue_loc (input_location, t);
}
-/* This provides WRITE access to the data field.
-
- TUPLES_P is true if we are generating tuples.
-
- This function gets called through the following macros:
- gfc_conv_descriptor_data_set
- gfc_conv_descriptor_data_set. */
-
void
-gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+conv_data_set (stmtblock_t *block, tree desc, tree value)
{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ tree field = get_data (desc);
gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
}
-
-/* This provides address access to the data field. This should only be
- used by array allocation, passing this on to the runtime. */
-
tree
-gfc_conv_descriptor_data_addr (tree desc)
+conv_data_addr (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ tree field = get_data (desc);
return gfc_build_addr_expr (NULL_TREE, field);
}
-static tree
-gfc_conv_descriptor_offset (tree desc)
+tree
+get_offset (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
+ tree field = get_component (desc, OFFSET_FIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-gfc_conv_descriptor_offset_get (tree desc)
+conv_offset_get (tree desc)
{
- return gfc_conv_descriptor_offset (desc);
+ return non_lvalue_loc (input_location, get_offset (desc));
}
void
-gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
- tree value)
+conv_offset_set (stmtblock_t *block, tree desc, tree value)
{
- tree t = gfc_conv_descriptor_offset (desc);
+ tree t = get_offset (desc);
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
-
tree
-gfc_conv_descriptor_dtype (tree desc)
+get_dtype (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
+ tree field = get_component (desc, DTYPE_FIELD);
gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
return field;
}
-static tree
-gfc_conv_descriptor_span (tree desc)
+tree
+conv_dtype_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_dtype (desc));
+}
+
+void
+conv_dtype_set (stmtblock_t *block, tree desc, tree val)
+{
+ tree t = get_dtype (desc);
+ gfc_add_modify (block, t, val);
+}
+
+tree
+get_span (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
+ tree field = get_component (desc, SPAN_FIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-gfc_conv_descriptor_span_get (tree desc)
+conv_span_get (tree desc)
{
- return gfc_conv_descriptor_span (desc);
+ return non_lvalue_loc (input_location, get_span (desc));
}
void
-gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
- tree value)
+conv_span_set (stmtblock_t *block, tree desc, tree value)
{
- tree t = gfc_conv_descriptor_span (desc);
+ tree t = get_span (desc);
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
-
tree
-gfc_conv_descriptor_rank (tree desc)
+get_rank (tree desc)
{
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
gcc_assert (tmp != NULL_TREE
&& TREE_TYPE (tmp) == signed_char_type_node);
@@ -363,14 +378,35 @@ gfc_conv_descriptor_rank (tree desc)
dtype, tmp, NULL_TREE);
}
+tree
+conv_rank_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_rank (desc));
+}
+
+void
+conv_rank_set (stmtblock_t *block, tree desc, tree val)
+{
+ location_t loc = input_location;
+ tree t = get_rank (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), val));
+}
+
+void
+conv_rank_set (stmtblock_t *block, tree desc, int val)
+{
+ tree t = get_rank (desc);
+ conv_rank_set (block, desc, build_int_cst (TREE_TYPE (t), val));
+}
tree
-gfc_conv_descriptor_version (tree desc)
+get_version (tree desc)
{
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
gcc_assert (tmp != NULL_TREE
&& TREE_TYPE (tmp) == integer_type_node);
@@ -378,16 +414,28 @@ gfc_conv_descriptor_version (tree desc)
dtype, tmp, NULL_TREE);
}
+tree
+conv_version_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_version (desc));
+}
-/* Return the element length from the descriptor dtype field. */
+void
+conv_version_set (stmtblock_t *block, tree desc, tree val)
+{
+ location_t loc = input_location;
+ tree t = get_version (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), val));
+}
tree
-gfc_conv_descriptor_elem_len (tree desc)
+get_elem_len (tree desc)
{
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
GFC_DTYPE_ELEM_LEN);
gcc_assert (tmp != NULL_TREE
@@ -396,14 +444,28 @@ gfc_conv_descriptor_elem_len (tree desc)
dtype, tmp, NULL_TREE);
}
+tree
+conv_elem_len_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_elem_len (desc));
+}
+
+void
+conv_elem_len_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_elem_len (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
tree
-gfc_conv_descriptor_attribute (tree desc)
+get_attribute (tree desc)
{
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
GFC_DTYPE_ATTRIBUTE);
gcc_assert (tmp!= NULL_TREE
@@ -413,12 +475,27 @@ gfc_conv_descriptor_attribute (tree desc)
}
tree
-gfc_conv_descriptor_type (tree desc)
+conv_attribute_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_attribute (desc));
+}
+
+void
+conv_attribute_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_attribute (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+tree
+get_type (tree desc)
{
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
gcc_assert (tmp!= NULL_TREE
&& TREE_TYPE (tmp) == signed_char_type_node);
@@ -427,41 +504,120 @@ gfc_conv_descriptor_type (tree desc)
}
tree
-gfc_get_descriptor_dimension (tree desc)
+conv_type_get (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
+ return non_lvalue_loc (input_location, get_type (desc));
+}
+
+void
+conv_type_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_type (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+tree
+get_dimensions (tree desc)
+{
+ tree field = get_component (desc, DIMENSION_FIELD);
gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
&& TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
return field;
}
+tree
+get_dimensions (tree desc, tree type)
+{
+ tree t = get_dimensions (desc);
+ return build4_loc (input_location, ARRAY_RANGE_REF, type, t,
+ gfc_index_zero_node, NULL_TREE, NULL_TREE);
+}
-static tree
-gfc_conv_descriptor_dimension (tree desc, tree dim)
+tree
+conv_dimensions_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_dimensions (desc));
+}
+
+tree
+conv_dimensions_get (tree desc, tree type)
+{
+ tree t = get_dimensions (desc, type);
+ return non_lvalue_loc (input_location, t);
+}
+
+void
+conv_dimensions_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_dimensions (desc, TREE_TYPE (value));
+ gfc_add_modify_loc (loc, block, t, value);
+}
+
+tree
+get_dimension (tree desc, tree dim)
{
tree tmp;
- tmp = gfc_get_descriptor_dimension (desc);
+ tmp = get_dimensions (desc);
return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
}
+tree
+conv_dimension_get (tree desc, tree dim)
+{
+ return non_lvalue_loc (input_location, get_dimension (desc, dim));
+}
+
+void
+conv_dimension_set (stmtblock_t *block, tree desc, tree dim, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_dimension (desc, dim);
+ gfc_add_modify_loc (loc, block, t, value);
+}
+
tree
-gfc_conv_descriptor_token (tree desc)
+get_token_field (tree desc)
{
gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
- tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
+ return get_field (desc, CAF_TOKEN_FIELD);
+}
+
+tree
+get_token (tree desc)
+{
+ gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
+ tree field = get_component (desc, CAF_TOKEN_FIELD);
/* Should be a restricted pointer - except in the finalization wrapper. */
gcc_assert (TREE_TYPE (field) == prvoid_type_node
|| TREE_TYPE (field) == pvoid_type_node);
return field;
}
-static tree
-gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
+tree
+conv_token_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_token (desc));
+}
+
+void
+conv_token_set (stmtblock_t *block, tree desc, tree value)
{
- tree tmp = gfc_conv_descriptor_dimension (desc, dim);
+ location_t loc = input_location;
+ tree t = get_token (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+tree
+get_subfield (tree desc, tree dim, unsigned field_idx)
+{
+ tree tmp = get_dimension (desc, dim);
tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
gcc_assert (field != NULL_TREE);
@@ -469,16 +625,16 @@ gfc_conv_descriptor_subfield (tree desc, tree dim,
unsigned field_idx)
tmp, field, NULL_TREE);
}
-static tree
-gfc_conv_descriptor_stride (tree desc, tree dim)
+tree
+get_stride (tree desc, tree dim)
{
- tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
+ tree field = get_subfield (desc, dim, STRIDE_SUBFIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-gfc_conv_descriptor_stride_get (tree desc, tree dim)
+conv_stride_get (tree desc, tree dim)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -489,59 +645,286 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim)
||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
return gfc_index_one_node;
- return gfc_conv_descriptor_stride (desc, dim);
+ return non_lvalue_loc (input_location, get_stride (desc, dim));
}
void
-gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
- tree dim, tree value)
+conv_stride_set (stmtblock_t *block, tree desc, tree dim, tree value)
{
- tree t = gfc_conv_descriptor_stride (desc, dim);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+ location_t loc = input_location;
+ tree t = get_stride (desc, dim);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
}
-static tree
-gfc_conv_descriptor_lbound (tree desc, tree dim)
+tree
+get_lbound (tree desc, tree dim)
{
- tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
+ tree field = get_subfield (desc, dim, LBOUND_SUBFIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-gfc_conv_descriptor_lbound_get (tree desc, tree dim)
+conv_lbound_get (tree desc, tree dim)
{
- return gfc_conv_descriptor_lbound (desc, dim);
+ return non_lvalue_loc (input_location, get_lbound (desc, dim));
}
void
-gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
- tree dim, tree value)
+conv_lbound_set (stmtblock_t *block, tree desc, tree dim, tree value)
{
- tree t = gfc_conv_descriptor_lbound (desc, dim);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+ location_t loc = input_location;
+ tree t = get_lbound (desc, dim);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
}
-static tree
-gfc_conv_descriptor_ubound (tree desc, tree dim)
+tree
+get_ubound (tree desc, tree dim)
{
- tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
+ tree field = get_subfield (desc, dim, UBOUND_SUBFIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
+tree
+conv_ubound_get (tree desc, tree dim)
+{
+ return non_lvalue_loc (input_location, get_ubound (desc, dim));
+}
+
+void
+conv_ubound_set (stmtblock_t *block, tree desc, tree dim, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_ubound (desc, dim);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+}
+
+}
+
+
+/* This provides READ-ONLY access to the data field. The field itself
+ doesn't have the proper type. */
+
+tree
+gfc_conv_descriptor_data_get (tree desc)
+{
+ return gfc_descriptor::conv_data_get (desc);
+}
+
+/* This provides WRITE access to the data field.
+
+ TUPLES_P is true if we are generating tuples.
+
+ This function gets called through the following macros:
+ gfc_conv_descriptor_data_set
+ gfc_conv_descriptor_data_set. */
+
+void
+gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_data_set (block, desc, value);
+}
+
+
+/* This provides address access to the data field. This should only be
+ used by array allocation, passing this on to the runtime. */
+
+tree
+gfc_conv_descriptor_data_addr (tree desc)
+{
+ return gfc_descriptor::conv_data_addr (desc);
+}
+
+tree
+gfc_conv_descriptor_offset_get (tree desc)
+{
+ return gfc_descriptor::conv_offset_get (desc);
+}
+
+void
+gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_offset_set (block, desc, value);
+}
+
+
+tree
+gfc_conv_descriptor_dtype_get (tree desc)
+{
+ return gfc_descriptor::conv_dtype_get (desc);
+}
+
+void
+gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree desc, tree val)
+{
+ gfc_descriptor::conv_dtype_set (block, desc, val);
+}
+
+tree
+gfc_conv_descriptor_span_get (tree desc)
+{
+ return gfc_descriptor::conv_span_get (desc);
+}
+
+void
+gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_span_set (block, desc, value);
+}
+
+tree
+gfc_conv_descriptor_dimension_get (tree desc, tree dim)
+{
+ return gfc_descriptor::conv_dimension_get (desc, dim);
+}
+
+tree
+gfc_conv_descriptor_dimensions_get (tree desc)
+{
+ return gfc_descriptor::conv_dimensions_get (desc);
+}
+
+tree
+gfc_conv_descriptor_dimensions_get (tree desc, tree type)
+{
+ return gfc_descriptor::conv_dimensions_get (desc, type);
+}
+
+void
+gfc_conv_descriptor_dimensions_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_dimensions_set (block, desc, value);
+}
+
+tree
+gfc_conv_descriptor_rank_get (tree desc)
+{
+ return gfc_descriptor::conv_rank_get (desc);
+}
+
+void
+gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, tree val)
+{
+ gfc_descriptor::conv_rank_set (block, desc, val);
+}
+
+void
+gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int val)
+{
+ gfc_descriptor::conv_rank_set (block, desc, val);
+}
+
+tree
+gfc_conv_descriptor_version_get (tree desc)
+{
+ return gfc_descriptor::conv_version_get (desc);
+}
+
+void
+gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree val)
+{
+ gfc_descriptor::conv_version_set (block, desc, val);
+}
+
+/* Return the element length from the descriptor dtype field. */
+
+tree
+gfc_conv_descriptor_elem_len_get (tree desc)
+{
+ return gfc_descriptor::conv_elem_len_get (desc);
+}
+
+void
+gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree desc, tree value)
+{
+ gfc_descriptor::conv_elem_len_set (block, desc, value);
+}
+
+tree
+gfc_conv_descriptor_attribute_get (tree desc)
+{
+ return gfc_descriptor::conv_attribute_get (desc);
+}
+
+void
+gfc_conv_descriptor_attribute_set (stmtblock_t *block, tree desc, tree value)
+{
+ gfc_descriptor::conv_attribute_set (block, desc, value);
+}
+
+tree
+gfc_conv_descriptor_type_get (tree desc)
+{
+ return gfc_descriptor::conv_type_get (desc);
+}
+
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, tree value)
+{
+ gfc_descriptor::conv_type_set (block, desc, value);
+}
+
+tree
+gfc_conv_descriptor_token_get (tree desc)
+{
+ return gfc_descriptor::conv_token_get (desc);
+}
+
+tree
+gfc_conv_descriptor_token_field (tree desc)
+{
+ return gfc_descriptor::get_token_field (desc);
+}
+
+void
+gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
+{
+ return gfc_descriptor::conv_token_set (block, desc, value);
+}
+
+tree
+gfc_conv_descriptor_stride_get (tree desc, tree dim)
+{
+ return gfc_descriptor::conv_stride_get (desc, dim);
+}
+
+void
+gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
+ tree dim, tree value)
+{
+ gfc_descriptor::conv_stride_set (block, desc, dim, value);
+}
+
+tree
+gfc_conv_descriptor_lbound_get (tree desc, tree dim)
+{
+ return gfc_descriptor::conv_lbound_get (desc, dim);
+}
+
+void
+gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
+ tree dim, tree value)
+{
+ return gfc_descriptor::conv_lbound_set (block, desc, dim, value);
+}
+
tree
gfc_conv_descriptor_ubound_get (tree desc, tree dim)
{
- return gfc_conv_descriptor_ubound (desc, dim);
+ return gfc_descriptor::conv_ubound_get (desc, dim);
}
void
gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
tree dim, tree value)
{
- tree t = gfc_conv_descriptor_ubound (desc, dim);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+ return gfc_descriptor::conv_ubound_set (block, desc, dim, value);
}
@@ -1822,7 +2205,7 @@ gfc_descriptor_rank (tree descriptor)
if (TREE_TYPE (descriptor) != NULL_TREE)
return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
- tree dim = gfc_get_descriptor_dimension (descriptor);
+ tree dim = gfc_conv_descriptor_dimensions_get (descriptor);
tree dim_type = TREE_TYPE (dim);
gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
tree idx_type = TYPE_DOMAIN (dim_type);
@@ -1843,9 +2226,8 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
int dest_rank = gfc_descriptor_rank (dest);
/* Set dtype. */
- tree dtype = gfc_conv_descriptor_dtype (dest);
tree tmp = gfc_get_dtype (TREE_TYPE (src));
- gfc_add_modify (block, dtype, tmp);
+ gfc_conv_descriptor_dtype_set (block, dest, tmp);
/* Copy data pointer. */
tree data = gfc_conv_descriptor_data_get (src);
@@ -1995,8 +2377,7 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
/* Set data value, dtype, and offset. */
tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
gfc_conv_descriptor_data_set (block, desc, fold_convert (tmp, ptr));
- gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
- gfc_get_dtype (TREE_TYPE (desc)));
+ gfc_conv_descriptor_dtype_set (block, desc, gfc_get_dtype (TREE_TYPE
(desc)));
/* Start scalarization of the bounds, using the shape argument. */
@@ -2110,10 +2491,10 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree
lhs_desc, tree rhs_desc,
gfc_index_zero_node);
gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
}
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
- gfc_conv_descriptor_dtype (rhs_desc));
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, lhs_rank));
+ gfc_conv_descriptor_dtype_set (&block, arr,
+ gfc_conv_descriptor_dtype_get (rhs_desc));
+ tree rank_value = build_int_cst (signed_char_type_node, lhs_rank);
+ gfc_conv_descriptor_rank_set (&block, arr, rank_value);
gfc_conv_descriptor_span_set (&block, arr,
gfc_conv_descriptor_span_get (arr));
gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
@@ -2137,37 +2518,44 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
{
/* 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));
+ tree dtype = gfc_get_dtype_rank_type (gfc_sym->as->rank, etype);
+ gfc_conv_descriptor_dtype_set (unconditional_block, gfc, dtype);
if (gfc_sym->as->type == AS_ASSUMED_RANK)
- gfc_add_modify (unconditional_block,
- gfc_conv_descriptor_rank (gfc), rank);
+ gfc_conv_descriptor_rank_set (unconditional_block, 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 elem_len_val = gfc_get_cfi_desc_elem_len (cfi);
+ gfc_conv_descriptor_elem_len_set (unconditional_block, gfc,
elem_len_val);
+
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);
+ tree type = gfc_conv_descriptor_type_get (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);
+
+ stmtblock_t set_void;
+ gfc_init_block (&set_void);
+ tree void_value = build_int_cst (TREE_TYPE (type), BT_VOID);
+ gfc_conv_descriptor_type_set (&set_void, gfc, void_value);
+
+ stmtblock_t set_unknown;
+ gfc_init_block (&set_unknown);
+ tree unknown_value = build_int_cst (TREE_TYPE (type), BT_UNKNOWN);
+ gfc_conv_descriptor_type_set (&set_unknown, gfc, unknown_value);
+
+ tree tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
cond,
+ gfc_finish_block (&set_void),
+ gfc_finish_block (&set_unknown));
/* 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),
@@ -2233,7 +2621,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
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));
+ gfc_conv_descriptor_elem_len_get (gfc));
else
elem_len = fold_convert (gfc_array_index_type,
gfc_get_cfi_desc_elem_len (cfi));
@@ -3426,14 +3814,14 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
if (rank_changer)
{
/* Take the dtype from the class expression. */
- dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (pre, tmp, dtype);
+ dtype = gfc_conv_descriptor_dtype_get (gfc_class_data_get
(class_expr));
+ gfc_conv_descriptor_dtype_set (pre, desc, dtype);
/* These transformational functions change the rank. */
- tmp = gfc_conv_descriptor_rank (desc);
- gfc_add_modify (pre, tmp,
- build_int_cst (TREE_TYPE (tmp), ss->loop->dimen));
+ tmp = gfc_conv_descriptor_rank_get (desc);
+ gfc_conv_descriptor_rank_set (pre, desc,
+ build_int_cst (TREE_TYPE (tmp),
+ ss->loop->dimen));
fcn_ss->info->class_container = NULL_TREE;
}
@@ -3450,8 +3838,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
else
{
/* Fill in the array dtype. */
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+ gfc_conv_descriptor_dtype_set (pre, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
}
info->descriptor = desc;
@@ -6902,7 +7290,7 @@ done:
&& (gfc_option.allow_std & GFC_STD_F202Y)))
gcc_assert (se.pre.head == NULL_TREE
&& se.post.head == NULL_TREE);
- rank = gfc_conv_descriptor_rank (se.expr);
+ rank = gfc_conv_descriptor_rank_get (se.expr);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
fold_convert (gfc_array_index_type,
@@ -7847,8 +8235,8 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
&& VAR_P (expr->ts.u.cl->backend_decl))
{
type = gfc_typenode_for_spec (&expr->ts);
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+ tree dtype_value = gfc_get_dtype_rank_type (rank, type);
+ gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
}
else if (expr->ts.type == BT_CHARACTER
&& expr->ts.deferred
@@ -7869,27 +8257,20 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
TREE_OPERAND (descriptor, 0), tmp, NULL_TREE);
tmp = fold_convert (gfc_charlen_type_node, tmp);
type = gfc_get_character_type_len (expr->ts.kind, tmp);
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+ tree dtype_value = gfc_get_dtype_rank_type (rank, type);
+ gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
}
else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
{
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
+ tree dtype_value = gfc_conv_descriptor_dtype_get (expr3_desc);
+ gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype_value);
}
else if (expr->ts.type == BT_CLASS && !explicit_ts
&& expr3 && expr3->ts.type != BT_CLASS
&& expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
- {
- tmp = gfc_conv_descriptor_elem_len (descriptor);
- gfc_add_modify (pblock, tmp,
- fold_convert (TREE_TYPE (tmp), expr3_elem_size));
- }
+ gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size);
else
- {
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
- }
+ gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
or_expr = logical_false_node;
@@ -8353,7 +8734,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
{
pointer = non_ulimate_coarray_ptr_comp ? se->expr
: gfc_conv_descriptor_data_get (se->expr);
- token = gfc_conv_descriptor_token (se->expr);
+ token = gfc_conv_descriptor_token_get (se->expr);
token = gfc_build_addr_expr (NULL_TREE, token);
}
else
@@ -8417,10 +8798,12 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
build_tree_list (NULL_TREE, alloc),
DECL_ATTRIBUTES (omp_alt_alloc));
omp_alt_alloc = build_call_expr (omp_alt_alloc, 3, align, sz, alloc);
- succ_add_expr = fold_build2_loc (input_location, MODIFY_EXPR,
- void_type_node,
- gfc_conv_descriptor_version (se->expr),
+
+ stmtblock_t set_version;
+ gfc_init_block (&set_version);
+ gfc_conv_descriptor_version_set (&set_version, se->expr,
build_int_cst (integer_type_node, 1));
+ succ_add_expr = gfc_finish_block (&set_version);
}
/* The allocatable variant takes the old pointer as first argument. */
@@ -9791,7 +10174,6 @@ set_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_expr *src_expr,
the offsets because all elements are within the array data. */
/* Set the dtype. */
- tmp = gfc_conv_descriptor_dtype (dest);
tree dtype;
if (src_expr->ts.type == BT_ASSUMED)
{
@@ -9800,11 +10182,11 @@ set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
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 (tmp2);
+ dtype = gfc_conv_descriptor_dtype_get (tmp2);
}
else
dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
- gfc_add_modify (block, tmp, dtype);
+ gfc_conv_descriptor_dtype_set (block, dest, dtype);
/* The 1st element in the section. */
tree base = gfc_index_zero_node;
@@ -9916,7 +10298,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_expr *src_expr,
tmp = INDIRECT_REF_P (src) ? TREE_OPERAND (src, 0) : src;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
{
- tmp = gfc_conv_descriptor_token (tmp);
+ tmp = gfc_conv_descriptor_token_get (tmp);
}
else if (DECL_P (tmp) && DECL_LANG_SPECIFIC (tmp)
&& GFC_DECL_TOKEN (tmp) != NULL_TREE)
@@ -9926,7 +10308,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_expr *src_expr,
tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
}
- gfc_add_modify (block, gfc_conv_descriptor_token (dest), tmp);
+ gfc_conv_descriptor_token_set (block, dest, tmp);
}
}
@@ -10469,7 +10851,7 @@ gfc_tree_array_size (stmtblock_t *block, tree desc,
gfc_expr *expr, tree dim)
{
if (expr->rank < 0)
rank = fold_convert (signed_char_type_node,
- gfc_conv_descriptor_rank (desc));
+ gfc_conv_descriptor_rank_get (desc));
else
rank = build_int_cst (signed_char_type_node, expr->rank);
}
@@ -10608,6 +10990,35 @@ is_pointer (gfc_expr *e)
return sym->attr.pointer || sym->attr.proc_pointer;
}
+
+static void
+copy_descriptor_info (stmtblock_t *block, tree src, tree dest, int rank,
gfc_ss *ss)
+{
+ tree old_field = gfc_conv_descriptor_dtype_get (src);
+ gfc_conv_descriptor_dtype_set (block, dest, old_field);
+
+ old_field = gfc_conv_descriptor_offset_get (src);
+ gfc_conv_descriptor_offset_set (block, dest, old_field);
+
+ for (int i = 0; i < rank; i++)
+ {
+ tree src_dim = gfc_rank_cst[get_array_ref_dim_for_loop_dim (ss, i)];
+ old_field = gfc_conv_descriptor_dimension_get (src, src_dim);
+ gfc_descriptor::conv_dimension_set (block, dest, gfc_rank_cst[i],
+ old_field);
+ }
+
+ if (flag_coarray == GFC_FCOARRAY_LIB
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src))
+ && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (src))
+ == GFC_ARRAY_ALLOCATABLE)
+ {
+ old_field = gfc_conv_descriptor_token_get (src);
+ gfc_conv_descriptor_token_set (block, dest, old_field);
+ }
+}
+
+
/* Convert an array for passing as an actual parameter. */
void
@@ -11004,41 +11415,14 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
}
else if (!ctree)
{
- tree old_field, new_field;
-
/* The original descriptor has transposed dims so we can't reuse
it directly; we have to create a new one. */
tree old_desc = tmp;
tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
- old_field = gfc_conv_descriptor_dtype (old_desc);
- new_field = gfc_conv_descriptor_dtype (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
-
- old_field = gfc_conv_descriptor_offset (old_desc);
- new_field = gfc_conv_descriptor_offset (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
-
- for (int i = 0; i < expr->rank; i++)
- {
- old_field = gfc_conv_descriptor_dimension (old_desc,
- gfc_rank_cst[get_array_ref_dim_for_loop_dim (ss, i)]);
- new_field = gfc_conv_descriptor_dimension (new_desc,
- gfc_rank_cst[i]);
- gfc_add_modify (&se->pre, new_field, old_field);
- }
-
- if (flag_coarray == GFC_FCOARRAY_LIB
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (old_desc))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (old_desc))
- == GFC_ARRAY_ALLOCATABLE)
- {
- old_field = gfc_conv_descriptor_token (old_desc);
- new_field = gfc_conv_descriptor_token (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
- }
-
+ copy_descriptor_info (&se->pre, old_desc, new_desc, expr->rank,
ss);
gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
+
se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
}
gfc_free_ss (ss);
@@ -11349,8 +11733,7 @@ duplicate_allocatable_coarray (tree dest, tree
dest_tok, tree src, tree type,
else
{
/* Set the rank or unitialized memory access may be reported. */
- tmp = gfc_conv_descriptor_rank (dest);
- gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp),
rank));
+ gfc_conv_descriptor_rank_set (&globalblock, dest, rank);
if (rank)
nelems = gfc_full_array_size (&globalblock, src, rank);
@@ -11438,8 +11821,8 @@ gfc_caf_is_dealloc_only (int caf_mode)
static void
set_contiguous_array (stmtblock_t *block, tree desc, tree size, tree data_ptr)
{
- gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
- gfc_get_dtype_rank_type (1, TREE_TYPE (desc)));
+ 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);
@@ -11853,7 +12236,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
decl, gfc_comp_caf_token (c),
NULL_TREE);
else if (attr->dimension && !attr->proc_pointer)
- caf_token = gfc_conv_descriptor_token (comp);
+ caf_token = gfc_conv_descriptor_token_get (comp);
}
tmp = gfc_deallocate_with_status (comp, NULL_TREE, NULL_TREE,
@@ -12051,11 +12434,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
if (c->attr.dimension)
{
/* Set the dtype, because caf_register needs it. */
- gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp),
- gfc_get_dtype (TREE_TYPE (comp)));
+ tree dtype_value = gfc_get_dtype (TREE_TYPE (comp));
+ gfc_conv_descriptor_dtype_set (&fnblock, comp, dtype_value);
tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
- token = gfc_conv_descriptor_token (tmp);
+ token = gfc_conv_descriptor_token_get (tmp);
}
else
{
@@ -12277,7 +12660,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
{
tree dst_tok;
if (c->as)
- dst_tok = gfc_conv_descriptor_token (dcmp);
+ dst_tok = gfc_conv_descriptor_token_get (dcmp);
else
{
dst_tok
@@ -12435,8 +12818,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
size = gfc_evaluate_now (size, &fnblock);
tmp = gfc_call_malloc (&fnblock, NULL, size);
gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
- tmp = gfc_conv_descriptor_dtype (comp);
- gfc_add_modify (&fnblock, tmp, gfc_get_dtype (ctype));
+ gfc_conv_descriptor_dtype_set (&fnblock, comp, gfc_get_dtype
(ctype));
if (c->initializer && c->initializer->rank)
{
@@ -12515,7 +12897,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
if (c->attr.pdt_array)
cd = fold_build2_loc (input_location, EQ_EXPR,
boolean_type_node,
- gfc_conv_descriptor_version (comp),
+ gfc_conv_descriptor_version_get
(comp),
build_int_cst (integer_type_node, 1));
else
cd = gfc_omp_call_is_alloc (tmp);
@@ -12526,8 +12908,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
gfc_init_block (&tblock);
gfc_add_expr_to_block (&tblock, t);
if (c->attr.pdt_array)
- gfc_add_modify (&tblock, gfc_conv_descriptor_version (comp),
- integer_zero_node);
+ gfc_conv_descriptor_version_set (&tblock, comp,
integer_zero_node);
tmp = build3_loc (input_location, COND_EXPR, void_type_node,
cd, gfc_finish_block (&tblock),
gfc_call_free (tmp));
@@ -13114,7 +13495,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
{
/* Unfortunately, the lhs vptr is set too early in many cases.
Play it safe by using the descriptor element length. */
- tmp = gfc_conv_descriptor_elem_len (desc);
+ tmp = gfc_conv_descriptor_elem_len_get (desc);
elemsize1 = fold_convert (gfc_array_index_type, tmp);
}
else
@@ -13228,8 +13609,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_index_zero_node);
}
- tmp = gfc_conv_descriptor_offset (desc);
- gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
+ gfc_conv_descriptor_offset_set (&loop_pre_block, desc,
gfc_index_zero_node);
tmp = fold_build2_loc (input_location, EQ_EXPR,
logical_type_node, array1,
@@ -13311,12 +13691,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
size2 = gfc_index_one_node;
for (n = 0; n < expr2->rank; n++)
{
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- loop->to[n], loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
+ tmp = gfc_conv_array_extent_dim (loop->from[n], loop->to[n], NULL);
size2 = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
tmp, size2);
@@ -13344,12 +13719,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
for (n = 0; n < expr2->rank; n++)
{
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- loop->to[n], loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
+ tmp = gfc_conv_array_extent_dim (loop->from[n], loop->to[n], NULL);
lbound = gfc_index_one_node;
ubound = tmp;
@@ -13394,11 +13764,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
/* Set the lhs descriptor and scalarizer offsets. For rank > 1,
the array offset is saved and the info.offset is used for a
running offset. Use the saved_offset instead. */
- tmp = gfc_conv_descriptor_offset (desc);
- gfc_add_modify (&fblock, tmp, offset);
+ gfc_conv_descriptor_offset_set (&fblock, desc, offset);
if (linfo->saved_offset
&& VAR_P (linfo->saved_offset))
- gfc_add_modify (&fblock, linfo->saved_offset, tmp);
+ gfc_add_modify (&fblock, linfo->saved_offset,
+ gfc_conv_descriptor_offset_get (desc));
/* Now set the deltas for the lhs. */
for (n = 0; n < expr1->rank; n++)
@@ -13442,27 +13812,25 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
&& expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
{
tree type;
- tmp = gfc_conv_descriptor_dtype (desc);
if (expr2->ts.u.cl->backend_decl)
type = gfc_typenode_for_spec (&expr2->ts);
else
type = gfc_typenode_for_spec (&expr1->ts);
- gfc_add_modify (&fblock, tmp,
- gfc_get_dtype_rank_type (expr1->rank,type));
+ tree dtype_value = gfc_get_dtype_rank_type (expr1->rank, type);
+ gfc_conv_descriptor_dtype_set (&fblock, desc, dtype_value);
}
else if (expr1->ts.type == BT_CLASS)
{
tree type;
- tmp = gfc_conv_descriptor_dtype (desc);
-
if (expr2->ts.type != BT_CLASS)
type = gfc_typenode_for_spec (&expr2->ts);
else
type = gfc_get_character_type_len (1, elemsize2);
- gfc_add_modify (&fblock, tmp,
- gfc_get_dtype_rank_type (expr2->rank,type));
+ tree dtype_value = gfc_get_dtype_rank_type (expr2->rank, type);
+ gfc_conv_descriptor_dtype_set (&fblock, desc, dtype_value);
+
/* Set the _len field as well... */
if (UNLIMITED_POLY (expr1))
{
@@ -13498,8 +13866,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
}
else if (coarray && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
{
- gfc_add_modify (&fblock, gfc_conv_descriptor_dtype (desc),
- gfc_get_dtype (TREE_TYPE (desc)));
+ gfc_conv_descriptor_dtype_set (&fblock, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
}
/* Realloc expression. Note that the scalarizer uses desc.data
@@ -13540,7 +13908,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
{
tree cond, omp_tmp;
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- gfc_conv_descriptor_version (desc),
+ gfc_conv_descriptor_version_get (desc),
build_int_cst (integer_type_node, 1));
omp_tmp = builtin_decl_explicit (BUILT_IN_GOMP_REALLOC);
omp_tmp = build_call_expr_loc (input_location, omp_tmp, 4,
@@ -13615,8 +13983,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
|| coarray))
&& expr1->ts.type != BT_CLASS)
{
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+ gfc_conv_descriptor_dtype_set (&alloc_block, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
}
if ((expr1->ts.type == BT_DERIVED)
@@ -13653,7 +14021,6 @@ void
gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
{
tree type, etype;
- tree tmp;
tree descriptor;
stmtblock_t init;
int rank;
@@ -13681,11 +14048,9 @@ gfc_trans_class_array (gfc_symbol * sym,
gfc_wrapped_block * block)
rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0);
gcc_assert (rank>=0);
- tmp = gfc_conv_descriptor_dtype (descriptor);
etype = gfc_get_element_type (type);
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
- gfc_get_dtype_rank_type (rank, etype));
- gfc_add_expr_to_block (&init, tmp);
+ tree dtype_value = gfc_get_dtype_rank_type (rank, etype);
+ gfc_conv_descriptor_dtype_set (&init, descriptor, dtype_value);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
input_location = loc;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 2dad79aa9993..836a177da014 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -188,25 +188,33 @@ void gfc_get_descriptor_offsets_for_info (const_tree,
tree *, tree *, tree *, tr
tree *, tree *, tree *, tree *);
tree gfc_conv_descriptor_data_get (tree);
-tree gfc_conv_descriptor_data_addr (tree);
tree gfc_conv_descriptor_offset_get (tree);
tree gfc_conv_descriptor_span_get (tree);
-tree gfc_conv_descriptor_dtype (tree);
-tree gfc_conv_descriptor_rank (tree);
-tree gfc_conv_descriptor_elem_len (tree);
-tree gfc_conv_descriptor_version (tree);
-tree gfc_conv_descriptor_attribute (tree);
-tree gfc_conv_descriptor_type (tree);
-tree gfc_get_descriptor_dimension (tree);
+tree gfc_conv_descriptor_dtype_get (tree);
+tree gfc_conv_descriptor_rank_get (tree);
+tree gfc_conv_descriptor_elem_len_get (tree);
+tree gfc_conv_descriptor_version_get (tree);
+tree gfc_conv_descriptor_attribute_get (tree);
+tree gfc_conv_descriptor_type_get (tree);
+tree gfc_conv_descriptor_dimension_get (tree);
+tree gfc_conv_descriptor_dimensions_get (tree);
+tree gfc_conv_descriptor_dimensions_get (tree, tree);
tree gfc_conv_descriptor_stride_get (tree, tree);
tree gfc_conv_descriptor_lbound_get (tree, tree);
tree gfc_conv_descriptor_ubound_get (tree, tree);
tree gfc_conv_descriptor_extent_get (tree, tree);
tree gfc_conv_descriptor_sm_get (tree, tree);
-tree gfc_conv_descriptor_token (tree);
+tree gfc_conv_descriptor_token_get (tree);
+tree gfc_conv_descriptor_token_field (tree);
void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_token_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_dtype_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_dimensions_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_version_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_rank_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_rank_set (stmtblock_t *, tree, int);
void gfc_conv_descriptor_span_set (stmtblock_t *, tree, tree);
void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree);
void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ad861247eb0f..8df09cfa46df 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5137,9 +5137,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym,
gfc_wrapped_block * block)
se.descriptor_only = 1;
gfc_conv_expr (&se, e);
descriptor = se.expr;
- se.expr = gfc_conv_descriptor_data_addr (se.expr);
- se.expr = build_fold_indirect_ref_loc (input_location,
- se.expr);
+ se.expr = gfc_conv_descriptor_data_get (se.expr);
}
gfc_free_expr (e);
@@ -7390,7 +7388,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
/* memcpy (lhs + idx*elem_len, rhs + shift, elem_len) */
tree elem_len;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
- elem_len = gfc_conv_descriptor_elem_len (gfc_desc);
+ elem_len = gfc_conv_descriptor_elem_len_get (gfc_desc);
else
elem_len = gfc_get_cfi_desc_elem_len (cfi);
lhs = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
@@ -7528,7 +7526,7 @@ done:
/* memcpy (lhs + shift, rhs + idx*elem_len, elem_len) */
tree elem_len;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
- elem_len = gfc_conv_descriptor_elem_len (gfc_desc);
+ elem_len = gfc_conv_descriptor_elem_len_get (gfc_desc);
else
elem_len = gfc_get_cfi_desc_elem_len (cfi);
rhs = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e0621d48702a..7b4e9c83f814 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -238,7 +238,7 @@ gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se
*outerse, gfc_expr *expr)
caf = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (comp), se.expr, comp, NULL_TREE);
else
- caf = gfc_conv_descriptor_token (se.expr);
+ caf = gfc_conv_descriptor_token_get (se.expr);
return gfc_build_addr_expr (NULL_TREE, caf);
}
@@ -814,12 +814,12 @@ gfc_class_array_data_assign (stmtblock_t *block, tree
lhs_desc, tree rhs_desc,
gfc_conv_descriptor_offset_set (block, lhs_desc,
gfc_conv_descriptor_offset_get (rhs_desc));
- gfc_add_modify (block, gfc_conv_descriptor_dtype (lhs_desc),
- gfc_conv_descriptor_dtype (rhs_desc));
+ gfc_conv_descriptor_dtype_set (block, lhs_desc,
+ gfc_conv_descriptor_dtype_get (rhs_desc));
/* Assign the dimension as range-ref. */
- tmp = gfc_get_descriptor_dimension (lhs_desc);
- tmp2 = gfc_get_descriptor_dimension (rhs_desc);
+ tmp = gfc_conv_descriptor_dimensions_get (lhs_desc);
+ tmp2 = gfc_conv_descriptor_dimensions_get (rhs_desc);
int rank = gfc_descriptor_rank (lhs_desc);
int rank2 = gfc_descriptor_rank (rhs_desc);
@@ -842,11 +842,8 @@ gfc_class_array_data_assign (stmtblock_t *block, tree
lhs_desc, tree rhs_desc,
}
}
- tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
- gfc_index_zero_node, NULL_TREE, NULL_TREE);
- tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2,
- gfc_index_zero_node, NULL_TREE, NULL_TREE);
- gfc_add_modify (block, tmp, tmp2);
+ tmp = gfc_conv_descriptor_dimensions_get (rhs_desc, type);
+ gfc_conv_descriptor_dimensions_set (block, lhs_desc, tmp);
}
/* Takes a derived type expression and returns the address of a temporary
@@ -896,7 +893,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
|| (parmse->ss && parmse->ss->info && parmse->ss->info->useflags)
|| e->rank != 0
|| fsym->ts.u.derived->components->as == nullptr)
- gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree),
caf_token);
+ gfc_conv_descriptor_token_set (&parmse->pre, ctree, caf_token);
}
if (optional)
@@ -2493,7 +2490,7 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree
*offset, tree caf_decl,
/* Coarray token. */
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
- *token = gfc_conv_descriptor_token (caf_decl);
+ *token = gfc_conv_descriptor_token_get (caf_decl);
else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
*token = GFC_DECL_TOKEN (caf_decl);
@@ -3331,7 +3328,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
char *msg;
dim = fold_convert (signed_char_type_node,
- gfc_conv_descriptor_rank (se->expr));
+ gfc_conv_descriptor_rank_get (se->expr));
dim = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node,
dim, build_int_cst (signed_char_type_node, 1));
lower = gfc_conv_descriptor_lbound_get (se->expr, dim);
@@ -6100,7 +6097,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
gfc_add_modify (&block, tmp,
build_int_cst (TREE_TYPE (tmp), CFI_VERSION));
if (e->rank < 0)
- rank = fold_convert (signed_char_type_node, gfc_conv_descriptor_rank
(gfc));
+ rank = fold_convert (signed_char_type_node,
+ gfc_conv_descriptor_rank_get (gfc));
else
rank = build_int_cst (signed_char_type_node, e->rank);
tmp = gfc_get_cfi_desc_rank (cfi);
@@ -6231,7 +6229,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
}
else if (e->ts.type == BT_ASSUMED)
{
- tmp = gfc_conv_descriptor_elem_len (gfc);
+ tmp = gfc_conv_descriptor_elem_len_get (gfc);
tmp2 = gfc_get_cfi_desc_elem_len (cfi);
gfc_add_modify (&block2, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
}
@@ -6244,9 +6242,9 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
tree cond;
tree ctype = gfc_get_cfi_desc_type (cfi);
tree type = fold_convert (TREE_TYPE (ctype),
- gfc_conv_descriptor_type (gfc));
+ gfc_conv_descriptor_type_get (gfc));
tree kind = fold_convert (TREE_TYPE (ctype),
- gfc_conv_descriptor_elem_len (gfc));
+ gfc_conv_descriptor_elem_len_get (gfc));
kind = fold_build2_loc (input_location, LSHIFT_EXPR, TREE_TYPE (type),
kind, build_int_cst (TREE_TYPE (type),
CFI_type_kind_shift));
@@ -6631,13 +6629,10 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e,
gfc_symbol * fsym)
For an assumed-rank dummy we provide a descriptor that passes
the correct rank. */
{
- tree rank;
tree tmp = parmse->expr;
tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, gfc_expr_attr (e));
- rank = gfc_conv_descriptor_rank (tmp);
- gfc_add_modify (&parmse->pre, rank,
- build_int_cst (TREE_TYPE (rank), e->rank));
+ gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank);
gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
}
@@ -6654,11 +6649,7 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e,
gfc_symbol * fsym)
tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr);
dummy_rank = fsym->as ? fsym->as->rank : 0;
if (dummy_rank > 0)
- {
- tree rank = gfc_conv_descriptor_rank (tmp);
- gfc_add_modify (&parmse->pre, rank,
- build_int_cst (TREE_TYPE (rank), dummy_rank));
- }
+ gfc_conv_descriptor_rank_set (&parmse->pre, tmp, dummy_rank);
gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node);
parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp);
}
@@ -8215,7 +8206,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl))
? build_fold_indirect_ref (caf_decl)
: caf_decl;
- tmp = gfc_conv_descriptor_token (tmp);
+ tmp = gfc_conv_descriptor_token_get (tmp);
}
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
@@ -10030,7 +10021,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr,
bool init, bool coarray)
token
= is_array
- ? gfc_conv_descriptor_token (field)
+ ? gfc_conv_descriptor_token_get (field)
: fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (gfc_comp_caf_token (cm)), dest,
gfc_comp_caf_token (cm), NULL_TREE);
@@ -10048,8 +10039,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr,
bool init, bool coarray)
rank = 1;
size = build_zero_cst (size_type_node);
desc = field;
- gfc_add_modify (&block, gfc_conv_descriptor_rank (desc),
- build_int_cst (signed_char_type_node, rank));
+ gfc_conv_descriptor_rank_set (&block, desc, rank);
}
else
{
@@ -11355,10 +11345,10 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse,
gfc_typespec ts,
{
if (flag_coarray == GFC_FCOARRAY_LIB && assoc_assign)
{
- gfc_add_modify (&block, gfc_conv_descriptor_token (lse->expr),
- TYPE_LANG_SPECIFIC (
- TREE_TYPE (TREE_TYPE (rse->expr)))
- ->caf_token);
+ tree token_value = TYPE_LANG_SPECIFIC (
+ TREE_TYPE (TREE_TYPE (rse->expr)))
+ ->caf_token;
+ gfc_conv_descriptor_token_set (&block, lse->expr, token_value);
}
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (lse->expr)))
lse->expr = gfc_conv_array_data (lse->expr);
@@ -11573,11 +11563,9 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
desc = build_fold_indirect_ref_loc (input_location, desc);
/* Unallocated, the descriptor does not have a dtype. */
- tmp = gfc_conv_descriptor_dtype (desc);
- if (dtype != NULL_TREE)
- gfc_add_modify (&se->pre, tmp, dtype);
- else
- gfc_add_modify (&se->pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+ if (dtype == NULL_TREE)
+ dtype = gfc_get_dtype (TREE_TYPE (desc));
+ gfc_conv_descriptor_dtype_set (&se->pre, desc, dtype);
res_desc = gfc_evaluate_now (desc, &se->pre);
gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 0ef69647a6ea..40aea99924be 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1317,8 +1317,8 @@ conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr
*expr)
{
tree arr_desc_token_offset;
/* Get the token field from the descriptor. */
- arr_desc_token_offset = TREE_OPERAND (
- gfc_conv_descriptor_token
(ref->u.c.component->backend_decl), 1);
+ tree descriptor = ref->u.c.component->backend_decl;
+ arr_desc_token_offset = gfc_conv_descriptor_token_field
(descriptor);
arr_desc_token_offset
= compute_component_offset (arr_desc_token_offset,
TREE_TYPE (tmp));
@@ -2016,12 +2016,11 @@ conv_caf_send (gfc_code *code) {
has the wrong type if component references are done. */
lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (
- gfc_has_vector_subscript (lhs_expr)
- ? gfc_find_array_ref (lhs_expr)->dimen
- : lhs_expr->rank,
- lhs_type));
+ int rank = gfc_has_vector_subscript (lhs_expr)
+ ? gfc_find_array_ref (lhs_expr)->dimen
+ : lhs_expr->rank;
+ tree dtype_value = gfc_get_dtype_rank_type (rank, lhs_type);
+ gfc_conv_descriptor_dtype_set (&lhs_se.pre, tmp, dtype_value);
}
else
{
@@ -2048,10 +2047,10 @@ conv_caf_send (gfc_code *code) {
that has the wrong type if component references are done. */
lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : lhs_expr->rank,
- lhs_type));
+ tree dtype_value = gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ :
lhs_expr->rank,
+ lhs_type);
+ gfc_conv_descriptor_dtype_set (&lhs_se.pre, tmp, dtype_value);
if (has_tmp_lhs_array)
{
vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
@@ -2228,12 +2227,11 @@ conv_caf_send (gfc_code *code) {
has the wrong type if component references are done. */
tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
- gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (
- gfc_has_vector_subscript (rhs_expr)
- ? gfc_find_array_ref (rhs_expr)->dimen
- : rhs_expr->rank,
- tmp2));
+ int rank = gfc_has_vector_subscript (rhs_expr)
+ ? gfc_find_array_ref (rhs_expr)->dimen
+ : rhs_expr->rank;
+ tree dtype_value = gfc_get_dtype_rank_type (rank, tmp2);
+ gfc_conv_descriptor_dtype_set (&rhs_se.pre, tmp, dtype_value);
}
else
{
@@ -2258,11 +2256,10 @@ conv_caf_send (gfc_code *code) {
has the wrong type if component references are done. */
tmp = build_fold_indirect_ref_loc (input_location, rhs_se.expr);
tmp2 = gfc_typenode_for_spec (&rhs_expr->ts);
- gfc_add_modify (&rhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : rhs_expr->rank,
- tmp2));
- if (has_vector)
+ int rank = has_vector ? ar2.dimen : rhs_expr->rank;
+ tree dtype_value = gfc_get_dtype_rank_type (rank, tmp2);
+ gfc_conv_descriptor_dtype_set (&rhs_se.pre, tmp, dtype_value);
+ if (has_vector)
{
rhs_vec = conv_caf_vector_subscript (&block, rhs_se.expr, &ar2);
*ar = ar2;
@@ -2869,7 +2866,7 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
- se->expr = gfc_conv_descriptor_rank (argse.expr);
+ se->expr = gfc_conv_descriptor_rank_get (argse.expr);
se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
se->expr);
}
@@ -3038,7 +3035,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr,
enum gfc_isym_id op)
cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
bound, build_int_cst (TREE_TYPE (bound), 0));
if (as && as->type == AS_ASSUMED_RANK)
- tmp = gfc_conv_descriptor_rank (desc);
+ tmp = gfc_conv_descriptor_rank_get (desc);
else
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
@@ -3133,7 +3130,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr,
enum gfc_isym_id op)
{
tree minus_one = build_int_cst (gfc_array_index_type, -1);
tree rank = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_rank (desc));
+ gfc_conv_descriptor_rank_get (desc));
rank = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, rank, minus_one);
@@ -8739,7 +8736,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
tree lower;
tree upper;
tree byte_size;
- tree field;
int n;
gfc_init_se (&argse, NULL);
@@ -8763,12 +8759,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_conv_descriptor_dtype (tmp);
- field = gfc_advance_chain (TYPE_FIELDS (get_dtype_type_node ()),
- GFC_DTYPE_ELEM_LEN);
- tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- tmp, field, NULL_TREE);
-
+ tmp = gfc_conv_descriptor_elem_len_get (tmp);
byte_size = fold_convert (gfc_array_index_type, tmp);
}
else if (arg->ts.type == BT_CLASS)
@@ -8832,7 +8823,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
stmtblock_t body;
tmp = fold_convert (gfc_array_index_type,
- gfc_conv_descriptor_rank (argse.expr));
+ gfc_conv_descriptor_rank_get (argse.expr));
loop_var = gfc_create_var (gfc_array_index_type, "i");
gfc_add_modify (&argse.pre, loop_var, gfc_index_zero_node);
exit_label = gfc_build_label_decl (NULL_TREE);
@@ -9698,7 +9689,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
gfc_conv_expr_lhs (&arg1se, arg1->expr);
if (arg1->expr->rank == -1)
{
- tmp = gfc_conv_descriptor_rank (arg1se.expr);
+ tmp = gfc_conv_descriptor_rank_get (arg1se.expr);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
TREE_TYPE (tmp), tmp,
build_int_cst (TREE_TYPE (tmp), 1));
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 580d5837bd5f..808998df7ff8 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -189,7 +189,7 @@ gfc_omp_array_size (tree decl, gimple_seq *pre_p)
size = fold_convert (size_type_node, size);
tree elemsz = gfc_get_element_type (TREE_TYPE (decl));
if (TREE_CODE (elemsz) == ARRAY_TYPE && TYPE_STRING_FLAG (elemsz))
- elemsz = gfc_conv_descriptor_elem_len (decl);
+ elemsz = gfc_conv_descriptor_elem_len_get (decl);
else
elemsz = TYPE_SIZE_UNIT (elemsz);
size = fold_build2 (MULT_EXPR, size_type_node, size, elemsz);
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 01fb8d91007f..f4e3ea36cbe3 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2092,9 +2092,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
{
/* Recover the dtype, which has been overwritten by the
assignment from an unlimited polymorphic object. */
- tmp = gfc_conv_descriptor_dtype (sym->backend_decl);
- gfc_add_modify (&se.pre, tmp,
- gfc_get_dtype (TREE_TYPE (sym->backend_decl)));
+ tree dtype_val = gfc_get_dtype (TREE_TYPE (sym->backend_decl));
+ gfc_conv_descriptor_dtype_set (&se.pre, sym->backend_decl, dtype_val);
}
gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
@@ -3856,7 +3855,7 @@ gfc_trans_select_rank_cases (gfc_code * code)
/* Calculate the switch expression. */
gfc_init_se (&se, NULL);
gfc_conv_expr_descriptor (&se, code->expr1);
- rank = gfc_conv_descriptor_rank (se.expr);
+ rank = gfc_conv_descriptor_rank_get (se.expr);
rank = gfc_evaluate_now (rank, &block);
symbol_attribute attr = gfc_expr_attr (code->expr1);
if (!attr.pointer && !attr.allocatable)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index b03dcc1fb1a4..9880726c6113 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1825,7 +1825,7 @@ gfc_deallocate_with_status (tree pointer, tree status,
tree errmsg,
caf_type = TREE_TYPE (caf_decl);
STRIP_NOPS (pointer);
if (GFC_DESCRIPTOR_TYPE_P (caf_type))
- token = gfc_conv_descriptor_token (caf_decl);
+ token = gfc_conv_descriptor_token_get (caf_decl);
else if (DECL_LANG_SPECIFIC (caf_decl)
&& GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
token = GFC_DECL_TOKEN (caf_decl);
@@ -1914,7 +1914,7 @@ gfc_deallocate_with_status (tree pointer, tree status,
tree errmsg,
tree cond, omp_tmp;
if (descr)
cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- gfc_conv_descriptor_version (descr),
+ gfc_conv_descriptor_version_get (descr),
integer_one_node);
else
cond = gfc_omp_call_is_alloc (pointer);
@@ -1928,8 +1928,7 @@ gfc_deallocate_with_status (tree pointer, tree status,
tree errmsg,
gfc_add_modify (&non_null, pointer, build_int_cst (TREE_TYPE (pointer),
0));
if (flag_openmp_allocators && descr)
- gfc_add_modify (&non_null, gfc_conv_descriptor_version (descr),
- integer_zero_node);
+ gfc_conv_descriptor_version_set (&non_null, descr, integer_zero_node);
if (status != NULL_TREE && !integer_zerop (status))
{
