From: Mikael Morin <[email protected]>
Regression tested on powerpc64le-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.
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 | 13 +++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 12 +++++-------
gcc/fortran/trans-intrinsic.cc | 3 +--
5 files changed, 25 insertions(+), 16 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bd9f66a34d6..7938456462e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8442,7 +8442,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;
}
@@ -9060,7 +9060,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
}
else if (!ctree)
{
- tree old_field, new_field;
+ tree old_field;
/* The original descriptor has transposed dims so we can't reuse
it directly; we have to create a new one. */
@@ -9087,8 +9087,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);
@@ -11974,9 +11974,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 5f7b9955ad0..05e5e1a9294 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -464,6 +464,19 @@ gfc_conv_descriptor_token (tree desc)
return field;
}
+/* Add code to BLOCK setting to VALUE the coarray token for the array
+ represented by 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 8c28eb1c54a..9982fa446a3 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -54,6 +54,7 @@ void gfc_conv_descriptor_dimension_set (stmtblock_t *, tree,
int, 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 a676152328b..c22e9dbcad3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -849,7 +849,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)
@@ -9947,8 +9947,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)
{
@@ -11745,10 +11744,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 5f5463fd516..ca233775eb5 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -13408,8 +13408,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.51.0
