From: Mikael Morin <[email protected]>
Regression tested on aarch64-unknown-linux-gnu. OK for master?
-- >8 --
Add accessor functions to get or set the value of the type field of array
descriptors, and remove from the public API the function giving direct acces
to the field.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-descriptor.cc (get_type_field): New function.
(gfc_get_descriptor_field): Use it.
(gfc_conv_descriptor_type): Make static and rename ...
(conv_descriptor_type): ... to this.
(gfc_conv_descriptor_type_get, gfc_conv_descriptor_type_set): New
functions.
* trans-descriptor.h (gfc_conv_descriptor_type): Remove declaration.
(gfc_conv_descriptor_type_get, gfc_conv_descriptor_type_set): New
declarations.
* trans-expr.cc (gfc_conv_gfc_desc_to_cfi_desc): Use
gfc_conv_descriptor_type_get to get the value of the type field.
* trans-decl.cc (gfc_conv_cfi_to_gfc): Use
gfc_conv_descriptor_type_set to set the value of the type field.
---
gcc/fortran/trans-decl.cc | 23 +++------
gcc/fortran/trans-descriptor.cc | 89 +++++++++++++++++++++++++++++++--
gcc/fortran/trans-descriptor.h | 6 ++-
gcc/fortran/trans-expr.cc | 2 +-
4 files changed, 98 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 09bffa39718..fab4873b92c 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7526,25 +7526,20 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
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_desc);
/* 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));
- tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type,
- build_int_cst (TREE_TYPE (type), BT_UNKNOWN));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID);
+ tmp2 = gfc_conv_descriptor_type_set (gfc_desc, 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));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_DERIVED);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
/* if (CFI_type_Character) BT_CHARACTER else < tmp2 > */
@@ -7553,8 +7548,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
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));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, 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 > */
@@ -7566,16 +7560,14 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
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));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, 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));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, 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)
@@ -7593,8 +7585,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
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));
+ tmp = gfc_conv_descriptor_type_set (gfc_desc, ctype);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, tmp2);
gfc_add_expr_to_block (&block, tmp2);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 2cdeb20b049..163916bfc27 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -61,14 +61,28 @@ along with GCC; see the file COPYING3. If not see
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
+
+/* Get FIELD_IDX'th field in struct TYPE. */
+
+static tree
+get_type_field (tree type, unsigned field_idx)
+{
+ tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
+ gcc_assert (field != NULL_TREE);
+
+ return field;
+}
+
+
+/* Return a reference to the FIELD_IDX-th field of the descriptor DESC. */
+
static tree
gfc_get_descriptor_field (tree desc, unsigned field_idx)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
- gcc_assert (field != NULL_TREE);
+ tree field = get_type_field (type, field_idx);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
@@ -295,8 +309,12 @@ gfc_conv_descriptor_attribute (tree desc)
dtype, tmp, NULL_TREE);
}
-tree
-gfc_conv_descriptor_type (tree desc)
+
+/* Return a reference to the type discriminator field of the array descriptor
+ DESC. */
+
+static tree
+conv_descriptor_type (tree desc)
{
tree tmp;
tree dtype;
@@ -309,6 +327,69 @@ gfc_conv_descriptor_type (tree desc)
dtype, tmp, NULL_TREE);
}
+/* Return the type discriminator value of the array descriptor DESC. */
+
+tree
+gfc_conv_descriptor_type_get (tree desc)
+{
+ return conv_descriptor_type (desc);
+}
+
+/* Add code to BLOCK assigning VALUE to the type discriminator field of the
+ array descriptor DESC. */
+
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = conv_descriptor_type (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+/* Add code to BLOCK assigning VALUE to the type discriminator field of the
+ array descriptor DESC. */
+
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, int value)
+{
+ tree type = TREE_TYPE (desc);
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+ tree dtype = get_type_field (type, DTYPE_FIELD);
+ tree field = get_type_field (TREE_TYPE (dtype), GFC_DTYPE_TYPE);
+ tree type_value = build_int_cst (TREE_TYPE (field), value);
+
+ gfc_conv_descriptor_type_set (block, desc, type_value);
+}
+
+/* Return a statement assigning VALUE to the type discriminator field of the
+ array descriptor DESC. */
+
+tree
+gfc_conv_descriptor_type_set (tree desc, tree value)
+{
+ stmtblock_t block;
+
+ gfc_init_block (&block);
+ gfc_conv_descriptor_type_set (&block, desc, value);
+ return gfc_finish_block (&block);
+}
+
+/* Return a statement assigning VALUE to the type discriminator field of the
+ array descriptor DESC. */
+
+tree
+gfc_conv_descriptor_type_set (tree desc, int value)
+{
+ stmtblock_t block;
+
+ gfc_init_block (&block);
+ gfc_conv_descriptor_type_set (&block, desc, value);
+ return gfc_finish_block (&block);
+}
+
+
tree
gfc_get_descriptor_dimension (tree desc)
{
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index cdf2295abe4..e59ed8ed7b5 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -22,7 +22,6 @@ along with GCC; see the file COPYING3. If not see
tree gfc_conv_descriptor_dtype (tree);
tree gfc_conv_descriptor_attribute (tree);
-tree gfc_conv_descriptor_type (tree);
tree gfc_get_descriptor_dimension (tree);
tree gfc_conv_descriptor_dimension (tree, tree);
tree gfc_conv_descriptor_token (tree);
@@ -32,6 +31,7 @@ tree gfc_conv_descriptor_offset_get (tree);
tree gfc_conv_descriptor_elem_len_get (tree);
tree gfc_conv_descriptor_version_get (tree);
tree gfc_conv_descriptor_rank_get (tree);
+tree gfc_conv_descriptor_type_get (tree);
tree gfc_conv_descriptor_span_get (tree);
tree gfc_conv_descriptor_stride_get (tree, tree);
@@ -44,6 +44,10 @@ void gfc_conv_descriptor_elem_len_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_type_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_type_set (stmtblock_t *, tree, int);
+tree gfc_conv_descriptor_type_set (tree, tree);
+tree gfc_conv_descriptor_type_set (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-expr.cc b/gcc/fortran/trans-expr.cc
index c98ca9d2173..30bc4559681 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6422,7 +6422,7 @@ 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_get (gfc));
kind = fold_build2_loc (input_location, LSHIFT_EXPR, TREE_TYPE (type),
--
2.53.0
