From: Mikael Morin <[email protected]>
Regression tested on aarch64-unknown-linux-gnu. OK for master?
-- >8 --
Add a setter function to set the value of the token field of array
descriptors.
Contrary to the preceding patches touching the other fields, this one
doesn't create a getter and retains direct access to the field. Indeed,
token is special because its address is taken and passed to library
functions to implement coarray behaviour.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-descriptor.cc (gfc_conv_descriptor_token_set): New function.
* trans-descriptor.h (gfc_conv_descriptor_token_set): New
declaration.
* trans-array.cc (gfc_conv_expr_descriptor,
gfc_conv_array_parameter, gfc_trans_deferred_array): Use
gfc_conv_descriptor_token_set to set the value of the token.
* trans-expr.cc (gfc_conv_derived_to_class,
gfc_trans_subcomponent_assign, gfc_trans_scalar_assign): Likewise.
* trans-intrinsic.cc (conv_intrinsic_move_alloc): Likewise.
---
gcc/fortran/trans-array.cc | 12 +++++-------
gcc/fortran/trans-descriptor.cc | 16 ++++++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 12 +++++-------
gcc/fortran/trans-intrinsic.cc | 3 +--
5 files changed, 28 insertions(+), 16 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index aa4ca1a8bc1..6d73b2370e9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8609,7 +8609,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
}
- gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp);
+ gfc_conv_descriptor_token_set (&loop.pre, parm, tmp);
}
desc = parm;
}
@@ -9257,7 +9257,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
{
/* The original descriptor may have transposed dims so we
can't reuse it directly; we have to create a new one. */
- tree old_field, new_field;
+ tree old_field;
tree old_desc = tmp;
tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
@@ -9375,8 +9375,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
== 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);
+ gfc_conv_descriptor_token_set (&se->pre, new_desc,
+ old_field);
}
gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
@@ -12447,9 +12447,7 @@ gfc_trans_deferred_array (gfc_symbol * sym,
gfc_wrapped_block * block)
image. This may happen, for example, with the caf_mpi
implementation. */
TREE_STATIC (descriptor) = 1;
- tmp = gfc_conv_descriptor_token (descriptor);
- gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
- null_pointer_node));
+ gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
}
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 61d5cf3c189..72c8b9c5f2b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -424,6 +424,9 @@ conv_descriptor_dimension (tree desc, tree dim)
}
+/* Return a reference to the coarray token field of the array descriptor
+ DESC. */
+
tree
gfc_conv_descriptor_token (tree desc)
{
@@ -435,6 +438,19 @@ gfc_conv_descriptor_token (tree desc)
return field;
}
+/* Add code to BLOCK assigning VALUE to the coarray token field of the array
+ descriptor DESC. */
+
+void
+gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = gfc_conv_descriptor_token (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+
static tree
gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
{
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index a17d4aca9e4..081bb45ef07 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -51,6 +51,7 @@ 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);
void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
+void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
/* Build expressions for accessing components of an array descriptor. */
void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f1a9ea220c4..df029bfd114 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -894,7 +894,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
- gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+ gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
}
if (optional)
@@ -10137,8 +10137,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component
* cm,
{
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
if (cm->attr.codimension && flag_coarray == GFC_FCOARRAY_LIB)
- gfc_add_modify (&block, gfc_conv_descriptor_token (dest),
- null_pointer_node);
+ gfc_conv_descriptor_token_set (&block, dest, null_pointer_node);
}
else if (cm->attr.allocatable || cm->attr.pdt_array)
{
@@ -11980,10 +11979,9 @@ 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 rtype = TREE_TYPE (TREE_TYPE (rse->expr));
+ tree rtoken = TYPE_LANG_SPECIFIC (rtype)->caf_token;
+ gfc_conv_descriptor_token_set (&block, lse->expr, rtoken);
}
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (lse->expr)))
lse->expr = gfc_conv_array_data (lse->expr);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 2c0af0c41fc..bb0499ad7b3 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -13607,8 +13607,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
{
/* Copy the array descriptor data has overwritten the to-token and
cleared
from.data. Now also clear the from.token. */
- gfc_add_modify (&block, gfc_conv_descriptor_token (from_se.expr),
- null_pointer_node);
+ gfc_conv_descriptor_token_set (&block, from_se.expr, null_pointer_node);
}
if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred)
--
2.53.0
