https://gcc.gnu.org/g:d3475767515eb85ad2408cf923e422b5c7794ad9
commit d3475767515eb85ad2408cf923e422b5c7794ad9 Author: Mikael Morin <[email protected]> Date: Tue Jul 15 17:17:33 2025 +0200 fortran: array descriptor: Add a setter for the token field 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. Diff: --- 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 bd9f66a34d69..7938456462e1 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 5f7b9955ad0c..05e5e1a9294f 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 faef56fc3803..2d076f384519 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 a676152328b8..c22e9dbcad38 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 5f5463fd5165..ca233775eb5a 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)
