Skip to content

R
riscv-gcc-1
Commit c78d3425 by Alessandro Fanfarillo
Options

CO_BROADCAST for derived types with allocatable components 

From-SVN: r276164
parent 9ab2f9ae
Showing with 260 additions and 58 deletions
gcc/fortran/ChangeLog
2019-09-26 Alessandro Fanfarillo <afanfa@gcc.gnu.org>
* trans-array.c (structure_alloc_comps):
Add new enum item for BCAST_ALLOC_COMP.
New argument for structure_alloc_comp, and new case to handle
recursive components in derived types.
* trans-array.c (gfc_bcast_alloc_comp): New function
used to handleco_broadcast for allocatable components
of derived types.
* trans-array.h: Add gfc_bcast_alloc_comp
* trans-intrinsics.c (conv_co_collective): Add check for
derived type variable and invocation of co_bcast_alloc_comp.
* trans.h: New data structure gfc_co_subroutines_args.
2019-09-25 David Malcolm <dmalcolm@redhat.com>
PR fortran/91426
......
gcc/fortran/trans-array.h
......@@ -52,6 +52,8 @@ bool gfc_caf_is_dealloc_only (int);
tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int, int cm = 0);
tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int, int cm = 0);
tree gfc_bcast_alloc_comp (gfc_symbol *, gfc_expr *, int, tree,
tree, tree, tree);
tree gfc_deallocate_alloc_comp_no_caf (gfc_symbol *, tree, int);
tree gfc_reassign_alloc_comp_caf (gfc_symbol *, tree, tree);
......
gcc/fortran/trans-intrinsic.c
......@@ -10786,13 +10786,12 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
}
}
static tree
conv_co_collective (gfc_code *code)
{
gfc_se argse;
stmtblock_t block, post_block;
tree fndecl, array, strlen, image_index, stat, errmsg, errmsg_len;
tree fndecl, array = NULL_TREE, strlen, image_index, stat, errmsg, errmsg_len;
gfc_expr *image_idx_expr, *stat_expr, *errmsg_expr, *opr_expr;
gfc_start_block (&block);
......@@ -10857,6 +10856,7 @@ conv_co_collective (gfc_code *code)
gfc_conv_expr_descriptor (&argse, code->ext.actual->expr);
array = argse.expr;
}
gfc_add_block_to_block (&block, &argse.pre);
gfc_add_block_to_block (&post_block, &argse.post);
......@@ -10915,46 +10915,64 @@ conv_co_collective (gfc_code *code)
gcc_unreachable ();
}
if (code->resolved_isym->id == GFC_ISYM_CO_SUM
|| code->resolved_isym->id == GFC_ISYM_CO_BROADCAST)
fndecl = build_call_expr_loc (input_location, fndecl, 5, array,
image_index, stat, errmsg, errmsg_len);
else if (code->resolved_isym->id != GFC_ISYM_CO_REDUCE)
fndecl = build_call_expr_loc (input_location, fndecl, 6, array, image_index,
stat, errmsg, strlen, errmsg_len);
gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED
? code->ext.actual->expr->ts.u.derived : NULL;
if (derived && derived->attr.alloc_comp
&& code->resolved_isym->id == GFC_ISYM_CO_BROADCAST)
/* The derived type has the attribute 'alloc_comp'. */
{
tree tmp = gfc_bcast_alloc_comp (derived, code->ext.actual->expr,
code->ext.actual->expr->rank,
image_index, stat, errmsg, errmsg_len);
gfc_add_expr_to_block (&block, tmp);
}
else
{
tree opr, opr_flags;
// FIXME: Handle TS29113's bind(C) strings with descriptor.
int opr_flag_int;
if (gfc_is_proc_ptr_comp (opr_expr))
{
gfc_symbol *sym = gfc_get_proc_ptr_comp (opr_expr)->ts.interface;
opr_flag_int = sym->attr.dimension
|| (sym->ts.type == BT_CHARACTER
&& !sym->attr.is_bind_c)
? GFC_CAF_BYREF : 0;
opr_flag_int |= opr_expr->ts.type == BT_CHARACTER
&& !sym->attr.is_bind_c
? GFC_CAF_HIDDENLEN : 0;
opr_flag_int |= sym->formal->sym->attr.value ? GFC_CAF_ARG_VALUE : 0;
}
if (code->resolved_isym->id == GFC_ISYM_CO_SUM
|| code->resolved_isym->id == GFC_ISYM_CO_BROADCAST)
fndecl = build_call_expr_loc (input_location, fndecl, 5, array,
image_index, stat, errmsg, errmsg_len);
else if (code->resolved_isym->id != GFC_ISYM_CO_REDUCE)
fndecl = build_call_expr_loc (input_location, fndecl, 6, array,
image_index, stat, errmsg,
strlen, errmsg_len);
else
{
opr_flag_int = gfc_return_by_reference (opr_expr->symtree->n.sym)
? GFC_CAF_BYREF : 0;
opr_flag_int |= opr_expr->ts.type == BT_CHARACTER
&& !opr_expr->symtree->n.sym->attr.is_bind_c
? GFC_CAF_HIDDENLEN : 0;
opr_flag_int |= opr_expr->symtree->n.sym->formal->sym->attr.value
? GFC_CAF_ARG_VALUE : 0;
tree opr, opr_flags;
// FIXME: Handle TS29113's bind(C) strings with descriptor.
int opr_flag_int;
if (gfc_is_proc_ptr_comp (opr_expr))
{
gfc_symbol *sym = gfc_get_proc_ptr_comp (opr_expr)->ts.interface;
opr_flag_int = sym->attr.dimension
|| (sym->ts.type == BT_CHARACTER
&& !sym->attr.is_bind_c)
? GFC_CAF_BYREF : 0;
opr_flag_int |= opr_expr->ts.type == BT_CHARACTER
&& !sym->attr.is_bind_c
? GFC_CAF_HIDDENLEN : 0;
opr_flag_int |= sym->formal->sym->attr.value
? GFC_CAF_ARG_VALUE : 0;
}
else
{
opr_flag_int = gfc_return_by_reference (opr_expr->symtree->n.sym)
? GFC_CAF_BYREF : 0;
opr_flag_int |= opr_expr->ts.type == BT_CHARACTER
&& !opr_expr->symtree->n.sym->attr.is_bind_c
? GFC_CAF_HIDDENLEN : 0;
opr_flag_int |= opr_expr->symtree->n.sym->formal->sym->attr.value
? GFC_CAF_ARG_VALUE : 0;
}
opr_flags = build_int_cst (integer_type_node, opr_flag_int);
gfc_conv_expr (&argse, opr_expr);
opr = argse.expr;
fndecl = build_call_expr_loc (input_location, fndecl, 8, array, opr,
opr_flags, image_index, stat, errmsg,
strlen, errmsg_len);
}
opr_flags = build_int_cst (integer_type_node, opr_flag_int);
gfc_conv_expr (&argse, opr_expr);
opr = argse.expr;
fndecl = build_call_expr_loc (input_location, fndecl, 8, array, opr, opr_flags,
image_index, stat, errmsg, strlen, errmsg_len);
}
gfc_add_expr_to_block (&block, fndecl);
......
gcc/fortran/trans.h
......@@ -107,6 +107,14 @@ typedef struct gfc_se
}
gfc_se;
typedef struct gfc_co_subroutines_args
{
tree image_index;
tree stat;
tree errmsg;
tree errmsg_len;
}
gfc_co_subroutines_args;
/* Denotes different types of coarray.
Please keep in sync with libgfortran/caf/libcaf.h. */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment