aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/coarray.cc
diff options
context:
space:
mode:
authorAndre Vehreschild <vehre@gcc.gnu.org>2025-01-29 12:42:18 +0100
committerAndre Vehreschild <vehre@gcc.gnu.org>2025-02-20 10:33:05 +0100
commit69eb02682b80b84dd0f562f19821c8c8c37ad243 (patch)
tree5f75429d92cdfb25f7430274faf7e4168cb3e7d5 /gcc/fortran/coarray.cc
parent15847252648ede9d2ad9eea398b7b870f62a2b30 (diff)
downloadgcc-69eb02682b80b84dd0f562f19821c8c8c37ad243.zip
gcc-69eb02682b80b84dd0f562f19821c8c8c37ad243.tar.gz
gcc-69eb02682b80b84dd0f562f19821c8c8c37ad243.tar.bz2
Fortran: Add send_to_remote [PR107635]
Refactor to use send_to_remote instead of the slow send_by_ref. gcc/fortran/ChangeLog: PR fortran/107635 * coarray.cc (move_coarray_ref): Move the coarray reference out of the given one. Especially when there is a regular array ref. (fixup_comp_refs): Move components refs to a derived type where the codim has been removed, aka a new type. (split_expr_at_caf_ref): Correctly split the reference chain. (remove_caf_ref): Simplify. (create_get_callback): Fix some deficiencies. (create_allocated_callback): Adapt to new signature of split. (create_send_callback): New function. (rewrite_caf_send): Rewrite a call to caf_send to caf_send_to_remote. (coindexed_code_callback): Treat caf_send and caf_sendget correctly. * gfortran.h (enum gfc_isym_id): Add SENDGET-isym. * gfortran.texi: Add documentation for send_to_remote. * resolve.cc (gfc_resolve_code): No longer generate send_by_ref when allocatable coarray (component) is on the lhs. * trans-decl.cc (gfc_build_builtin_function_decls): Add caf_send_to_remote decl. * trans-intrinsic.cc (conv_caf_func_index): Ensure the static variables created are not in a block-scope. (conv_caf_send_to_remote): Translate caf_send_to_remote calls. (conv_caf_send): Renamed to conv_caf_sendget. (conv_caf_sendget): Renamed from conv_caf_send. (gfc_conv_intrinsic_subroutine): Branch correctly for conv_caf_send and sendget. * trans.h: Correct decl. libgfortran/ChangeLog: * caf/libcaf.h: Add/Correct prototypes for caf_get_from_remote, caf_send_to_remote. * caf/single.c (struct accessor_hash_t): Rename accessor_t to getter_t. (_gfortran_caf_register_accessor): Use new name of getter_t. (_gfortran_caf_send_to_remote): New function for sending data to coarray on a remote image. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/send_char_array_1.f90: Extend test to catch more cases. * gfortran.dg/coarray_42.f90: Invert tests use, because no longer a send is needed when local memory in a coarray is allocated.
Diffstat (limited to 'gcc/fortran/coarray.cc')
-rw-r--r--gcc/fortran/coarray.cc402
1 files changed, 350 insertions, 52 deletions
diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index c4e637e..5002910 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -243,24 +243,124 @@ convert_coarray_class_to_derived_type (gfc_symbol *base, gfc_namespace *ns)
}
static void
+move_coarray_ref (gfc_ref **from, gfc_expr *expr)
+{
+ int i;
+ gfc_ref *to = expr->ref;
+ for (; to && to->next; to = to->next)
+ ;
+
+ if (!to)
+ {
+ expr->ref = gfc_get_ref ();
+ to = expr->ref;
+ to->type = REF_ARRAY;
+ }
+ gcc_assert (to->type == REF_ARRAY);
+ to->u.ar.as = gfc_copy_array_spec ((*from)->u.ar.as);
+ to->u.ar.codimen = (*from)->u.ar.codimen;
+ to->u.ar.dimen = (*from)->u.ar.dimen;
+ to->u.ar.type = AR_FULL;
+ to->u.ar.stat = (*from)->u.ar.stat;
+ (*from)->u.ar.stat = nullptr;
+ to->u.ar.team = (*from)->u.ar.team;
+ (*from)->u.ar.team = nullptr;
+ for (i = 0; i < to->u.ar.dimen; ++i)
+ {
+ to->u.ar.start[i] = nullptr;
+ to->u.ar.end[i] = nullptr;
+ to->u.ar.stride[i] = nullptr;
+ }
+ for (i = (*from)->u.ar.dimen; i < (*from)->u.ar.dimen + (*from)->u.ar.codimen;
+ ++i)
+ {
+ to->u.ar.dimen_type[i] = (*from)->u.ar.dimen_type[i];
+ to->u.ar.start[i] = (*from)->u.ar.start[i];
+ (*from)->u.ar.start[i] = nullptr;
+ to->u.ar.end[i] = (*from)->u.ar.end[i];
+ (*from)->u.ar.end[i] = nullptr;
+ to->u.ar.stride[i] = (*from)->u.ar.stride[i];
+ (*from)->u.ar.stride[i] = nullptr;
+ }
+ (*from)->u.ar.codimen = 0;
+ if ((*from)->u.ar.dimen == 0)
+ {
+ gfc_ref *nref = (*from)->next;
+ (*from)->next = nullptr;
+ gfc_free_ref_list (*from);
+ *from = nref;
+ }
+}
+
+static void
+fixup_comp_refs (gfc_expr *expr)
+{
+ gfc_symbol *type = expr->symtree->n.sym->ts.type == BT_DERIVED
+ ? expr->symtree->n.sym->ts.u.derived
+ : (expr->symtree->n.sym->ts.type == BT_CLASS
+ ? CLASS_DATA (expr->symtree->n.sym)->ts.u.derived
+ : nullptr);
+ if (!type)
+ return;
+ gfc_ref **pref = &(expr->ref);
+ for (gfc_ref *ref = expr->ref; ref && type;)
+ {
+ switch (ref->type)
+ {
+ case REF_COMPONENT:
+ gfc_find_component (type, ref->u.c.component->name, false, true,
+ pref);
+ if (!*pref)
+ {
+ /* This happens when there were errors previously. Just don't
+ crash. */
+ ref = nullptr;
+ break;
+ }
+ (*pref)->next = ref->next;
+ ref->next = NULL;
+ gfc_free_ref_list (ref);
+ ref = (*pref)->next;
+ type = (*pref)->u.c.component->ts.type == BT_DERIVED
+ ? (*pref)->u.c.component->ts.u.derived
+ : ((*pref)->u.c.component->ts.type == BT_CLASS
+ ? CLASS_DATA ((*pref)->u.c.component)->ts.u.derived
+ : nullptr);
+ pref = &(*pref)->next;
+ break;
+ case REF_ARRAY:
+ pref = &ref->next;
+ ref = ref->next;
+ break;
+ default:
+ gcc_unreachable ();
+ break;
+ }
+ }
+}
+
+static void
split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
- gfc_expr **post_caf_ref_expr)
+ gfc_expr **post_caf_ref_expr, bool for_send)
{
gfc_ref *caf_ref = NULL;
gfc_symtree *st;
gfc_symbol *base;
+ gfc_typespec *caf_ts;
bool created;
gcc_assert (expr->expr_type == EXPR_VARIABLE);
+ caf_ts = &expr->symtree->n.sym->ts;
if (!expr->symtree->n.sym->attr.codimension)
{
/* The coarray is in some component. Find it. */
caf_ref = expr->ref;
while (caf_ref)
{
- if (caf_ref->type == REF_COMPONENT
- && caf_ref->u.c.component->attr.codimension)
+ if (caf_ref->type == REF_ARRAY && caf_ref->u.ar.codimen != 0)
break;
+ if (caf_ref->type == REF_COMPONENT)
+ caf_ts = &caf_ref->u.c.component->ts;
caf_ref = caf_ref->next;
}
}
@@ -271,7 +371,7 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
st->n.sym->attr.flavor = FL_PARAMETER;
st->n.sym->attr.dummy = 1;
st->n.sym->attr.intent = INTENT_IN;
- st->n.sym->ts = caf_ref ? caf_ref->u.c.sym->ts : expr->symtree->n.sym->ts;
+ st->n.sym->ts = *caf_ts;
*post_caf_ref_expr = gfc_get_variable_expr (st);
(*post_caf_ref_expr)->where = expr->where;
@@ -279,7 +379,12 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
if (!caf_ref)
{
- (*post_caf_ref_expr)->ref = gfc_copy_ref (expr->ref);
+ (*post_caf_ref_expr)->ref = gfc_get_ref ();
+ *(*post_caf_ref_expr)->ref = *expr->ref;
+ expr->ref = nullptr;
+ move_coarray_ref (&(*post_caf_ref_expr)->ref, expr);
+ fixup_comp_refs (expr);
+
if (expr->symtree->n.sym->attr.dimension)
{
base->as = gfc_copy_array_spec (expr->symtree->n.sym->as);
@@ -292,34 +397,39 @@ split_expr_at_caf_ref (gfc_expr *expr, gfc_namespace *ns,
}
else
{
- (*post_caf_ref_expr)->ref = gfc_copy_ref (caf_ref->next);
- if (caf_ref->u.c.component->attr.dimension)
+ (*post_caf_ref_expr)->ref = gfc_get_ref ();
+ *(*post_caf_ref_expr)->ref = *caf_ref;
+ caf_ref->next = nullptr;
+ move_coarray_ref (&(*post_caf_ref_expr)->ref, expr);
+ fixup_comp_refs (expr);
+
+ if (caf_ref && caf_ref->u.ar.dimen)
{
- base->as = gfc_copy_array_spec (caf_ref->u.c.component->as);
+ base->as = gfc_copy_array_spec (caf_ref->u.ar.as);
base->as->corank = 0;
base->attr.dimension = 1;
- base->attr.allocatable = caf_ref->u.c.component->attr.allocatable;
- base->attr.pointer = caf_ref->u.c.component->attr.pointer;
+ base->attr.allocatable = caf_ref->u.ar.as->type != AS_EXPLICIT;
}
- base->ts = caf_ref->u.c.component->ts;
+ base->ts = *caf_ts;
}
(*post_caf_ref_expr)->ts = expr->ts;
if (base->ts.type == BT_CHARACTER)
{
base->ts.u.cl = gfc_get_charlen ();
- *base->ts.u.cl = *(caf_ref ? caf_ref->u.c.component->ts.u.cl
- : expr->symtree->n.sym->ts.u.cl);
+ *base->ts.u.cl = *(caf_ts->u.cl);
base->ts.deferred = 1;
base->ts.u.cl->length = nullptr;
}
-
- if (base->ts.type == BT_DERIVED)
+ else if (base->ts.type == BT_DERIVED)
remove_coarray_from_derived_type (base, ns);
else if (base->ts.type == BT_CLASS)
convert_coarray_class_to_derived_type (base, ns);
- gfc_expression_rank (expr);
gfc_expression_rank (*post_caf_ref_expr);
+ if (for_send)
+ gfc_expression_rank (expr);
+ else
+ expr->rank = (*post_caf_ref_expr)->rank;
}
static void add_caf_get_from_remote (gfc_expr *e);
@@ -647,18 +757,16 @@ create_caf_add_data_parameter_type (gfc_expr *expr, gfc_namespace *ns,
static void
remove_caf_ref (gfc_expr *expr, const bool conv_to_this_image_cafref = false)
{
- gfc_ref *ref = expr->ref, **pref = &expr->ref;
+ gfc_ref *ref = expr->ref;
while (ref && (ref->type != REF_ARRAY || ref->u.ar.codimen == 0))
{
ref = ref->next;
- pref = &ref->next;
}
if (ref && ref->type == REF_ARRAY && ref->u.ar.codimen != 0)
{
if (ref->u.ar.dimen != 0)
{
ref->u.ar.codimen = 0;
- pref = &ref->next;
ref = ref->next;
}
else
@@ -675,21 +783,10 @@ remove_caf_ref (gfc_expr *expr, const bool conv_to_this_image_cafref = false)
ref->next = NULL;
gfc_free_ref_list (ref);
ref = expr->ref;
- pref = &expr->ref;
}
}
}
- if (ref && ref->type == REF_COMPONENT)
- {
- gfc_find_component (expr->symtree->n.sym->ts.u.derived,
- ref->u.c.component->name, false, true, pref);
- if (*pref && *pref != ref)
- {
- (*pref)->next = ref->next;
- ref->next = NULL;
- gfc_free_ref_list (ref);
- }
- }
+ fixup_comp_refs (expr);
}
static gfc_expr *
@@ -719,7 +816,7 @@ create_get_callback (gfc_expr *expr)
mname = expr->symtree->n.sym->module;
else
mname = "main";
- name = xasprintf ("_caf_rget_%s_%s_%d", mname, tname, ++caf_sym_cnt);
+ name = xasprintf ("_caf_accessor_%s_%s_%d", mname, tname, ++caf_sym_cnt);
gfc_get_symbol (name, ns, &extproc);
extproc->declared_at = expr->where;
gfc_set_sym_referenced (extproc);
@@ -744,7 +841,7 @@ create_get_callback (gfc_expr *expr)
gfc_commit_symbol (proc);
free (name);
- split_expr_at_caf_ref (expr, sub_ns, &post_caf_ref_expr);
+ split_expr_at_caf_ref (expr, sub_ns, &post_caf_ref_expr, false);
if (ns->proc_name->attr.flavor == FL_MODULE)
proc->module = ns->proc_name->name;
@@ -809,8 +906,7 @@ create_get_callback (gfc_expr *expr)
{
buffer->ts.u.cl = gfc_get_charlen ();
*buffer->ts.u.cl = *expr->ts.u.cl;
- buffer->ts.deferred = 1;
- buffer->ts.u.cl->length = nullptr;
+ buffer->ts.u.cl->length = gfc_copy_expr (expr->ts.u.cl->length);
}
gfc_commit_symbol (buffer);
@@ -857,7 +953,7 @@ create_get_callback (gfc_expr *expr)
remove_caf_ref (post_caf_ref_expr);
get_data->ts.u.derived
= create_caf_add_data_parameter_type (code->expr2, ns, get_data);
- if (code->expr2->rank == 0)
+ if (code->expr2->rank == 0 && code->expr2->ts.type != BT_CHARACTER)
code->expr2 = gfc_build_intrinsic_call (ns, GFC_ISYM_C_LOC, "C_LOC",
gfc_current_locus, 1, code->expr2);
@@ -994,7 +1090,7 @@ create_allocated_callback (gfc_expr *expr)
free (name);
split_expr_at_caf_ref (expr->value.function.actual->expr, sub_ns,
- &post_caf_ref_expr);
+ &post_caf_ref_expr, true);
if (ns->proc_name->attr.flavor == FL_MODULE)
proc->module = ns->proc_name->name;
@@ -1086,10 +1182,198 @@ rewrite_caf_allocated (gfc_expr **e)
"caf_is_present_on_remote", (*e)->where, 3, *e,
present_hash_expr, present_fn_expr);
gfc_add_caf_accessor (present_hash_expr, present_fn_expr);
- wrapper->ts = (*e)->ts;
*e = wrapper;
}
+static gfc_expr *
+create_send_callback (gfc_expr *expr, gfc_expr *rhs)
+{
+ gfc_namespace *ns;
+ gfc_symbol *extproc, *proc, *buffer, *base, *send_data, *caller_image;
+ char tname[GFC_MAX_SYMBOL_LEN + 1];
+ char *name;
+ const char *mname;
+ gfc_expr *cb, *post_caf_ref_expr;
+ gfc_code *code;
+ gfc_code *backup_caf_accessor_prepend = caf_accessor_prepend;
+ caf_accessor_prepend = nullptr;
+
+ /* Find the top-level namespace. */
+ for (ns = gfc_current_ns; ns->parent; ns = ns->parent)
+ ;
+
+ if (expr->expr_type == EXPR_VARIABLE)
+ strcpy (tname, expr->symtree->name);
+ else
+ strcpy (tname, "dummy");
+ if (expr->symtree->n.sym->module)
+ mname = expr->symtree->n.sym->module;
+ else
+ mname = "main";
+ name = xasprintf ("_caf_accessor_%s_%s_%d", mname, tname, ++caf_sym_cnt);
+ gfc_get_symbol (name, ns, &extproc);
+ extproc->declared_at = expr->where;
+ gfc_set_sym_referenced (extproc);
+ ++extproc->refs;
+ gfc_commit_symbol (extproc);
+
+ /* Set up namespace. */
+ gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
+ sub_ns->sibling = ns->contained;
+ ns->contained = sub_ns;
+ sub_ns->resolved = 1;
+ /* Set up procedure symbol. */
+ gfc_find_symbol (name, sub_ns, 1, &proc);
+ sub_ns->proc_name = proc;
+ proc->attr.if_source = IFSRC_DECL;
+ proc->attr.access = ACCESS_PUBLIC;
+ gfc_add_subroutine (&proc->attr, name, NULL);
+ proc->attr.host_assoc = 1;
+ proc->attr.always_explicit = 1;
+ ++proc->refs;
+ proc->declared_at = expr->where;
+ gfc_commit_symbol (proc);
+ free (name);
+
+ split_expr_at_caf_ref (expr, sub_ns, &post_caf_ref_expr, true);
+
+ if (ns->proc_name->attr.flavor == FL_MODULE)
+ proc->module = ns->proc_name->name;
+ gfc_set_sym_referenced (proc);
+ /* Set up formal arguments. */
+ gfc_formal_arglist **argptr = &proc->formal;
+#define ADD_ARG(name, nsym, stype, skind, sintent) \
+ gfc_get_symbol (name, sub_ns, &nsym); \
+ nsym->ts.type = stype; \
+ nsym->ts.kind = skind; \
+ nsym->attr.flavor = FL_PARAMETER; \
+ nsym->attr.dummy = 1; \
+ nsym->attr.intent = sintent; \
+ nsym->declared_at = expr->where; \
+ gfc_set_sym_referenced (nsym); \
+ *argptr = gfc_get_formal_arglist (); \
+ (*argptr)->sym = nsym; \
+ argptr = &(*argptr)->next
+
+ name = xasprintf ("add_send_data_%s_%s_%d", mname, tname, caf_sym_cnt);
+ ADD_ARG (name, send_data, BT_DERIVED, 0, INTENT_IN);
+ gfc_commit_symbol (send_data);
+ free (name);
+
+ ADD_ARG ("caller_image", caller_image, BT_INTEGER, gfc_default_integer_kind,
+ INTENT_IN);
+ gfc_commit_symbol (caller_image);
+
+ // ADD_ARG (expr->symtree->name, base, BT_VOID, INTENT_IN);
+ base = post_caf_ref_expr->symtree->n.sym;
+ base->attr.intent = INTENT_INOUT;
+ gfc_set_sym_referenced (base);
+ gfc_commit_symbol (base);
+ *argptr = gfc_get_formal_arglist ();
+ (*argptr)->sym = base;
+ argptr = &(*argptr)->next;
+ gfc_commit_symbol (base);
+
+ ADD_ARG ("buffer", buffer, rhs->ts.type, rhs->ts.kind, INTENT_IN);
+ buffer->ts = rhs->ts;
+ if (rhs->rank)
+ {
+ buffer->as = gfc_get_array_spec ();
+ buffer->as->rank = rhs->rank;
+ buffer->as->type = AS_DEFERRED;
+ buffer->attr.allocatable = 1;
+ buffer->attr.dimension = 1;
+ }
+ if (buffer->ts.type == BT_CHARACTER)
+ {
+ buffer->ts.u.cl = gfc_get_charlen ();
+ *buffer->ts.u.cl = *rhs->ts.u.cl;
+ buffer->ts.deferred = 1;
+ buffer->ts.u.cl->length = gfc_copy_expr (rhs->ts.u.cl->length);
+ }
+ gfc_commit_symbol (buffer);
+#undef ADD_ARG
+
+ /* Set up code. */
+ /* Code: base = buffer; */
+ code = sub_ns->code = gfc_get_code (EXEC_ASSIGN);
+ code->loc = expr->where;
+ code->expr1 = post_caf_ref_expr;
+ if (code->expr1->ts.type == BT_CHARACTER
+ && code->expr1->ts.kind != buffer->ts.kind)
+ {
+ bool converted;
+ code->expr2 = gfc_lval_expr_from_sym (buffer);
+ converted = gfc_convert_chartype (code->expr2, &code->expr1->ts);
+ gcc_assert (converted);
+ }
+ else if (code->expr1->ts.type != buffer->ts.type)
+ {
+ bool converted;
+ code->expr2 = gfc_lval_expr_from_sym (buffer);
+ converted = gfc_convert_type_warn (code->expr2, &code->expr1->ts, 0, 0,
+ buffer->attr.dimension);
+ gcc_assert (converted);
+ }
+ else
+ code->expr2 = gfc_lval_expr_from_sym (buffer);
+ remove_caf_ref (post_caf_ref_expr);
+ send_data->ts.u.derived
+ = create_caf_add_data_parameter_type (code->expr1, ns, send_data);
+
+ cb = gfc_lval_expr_from_sym (extproc);
+ cb->ts.interface = extproc;
+
+ if (caf_accessor_prepend)
+ {
+ gfc_code *c = caf_accessor_prepend;
+ /* Find last in chain. */
+ for (; c->next; c = c->next)
+ ;
+ c->next = sub_ns->code;
+ sub_ns->code = caf_accessor_prepend;
+ }
+ caf_accessor_prepend = backup_caf_accessor_prepend;
+ return cb;
+}
+
+static void
+rewrite_caf_send (gfc_code *c)
+{
+ gfc_expr *send_to_remote_expr, *send_to_remote_hash_expr, *lhs, *rhs;
+ gfc_actual_arglist *arg = c->ext.actual;
+
+ lhs = arg->expr;
+ arg = arg->next;
+ rhs = arg->expr;
+ /* Detect an already rewritten caf_send. */
+ if (arg->next && arg->next->expr->expr_type == EXPR_CONSTANT
+ && arg->next->next && arg->next->next->expr->expr_type == EXPR_VARIABLE)
+ return;
+
+ if (gfc_is_coindexed (rhs))
+ {
+ c->resolved_isym->id = GFC_ISYM_CAF_SENDGET;
+ return;
+ }
+
+ send_to_remote_expr = create_send_callback (lhs, rhs);
+ send_to_remote_hash_expr = gfc_get_expr ();
+ send_to_remote_hash_expr->expr_type = EXPR_CONSTANT;
+ send_to_remote_hash_expr->ts.type = BT_INTEGER;
+ send_to_remote_hash_expr->ts.kind = gfc_default_integer_kind;
+ send_to_remote_hash_expr->where = lhs->where;
+ mpz_init_set_ui (send_to_remote_hash_expr->value.integer,
+ gfc_hash_value (send_to_remote_expr->symtree->n.sym));
+ arg->next = gfc_get_actual_arglist ();
+ arg = arg->next;
+ arg->expr = send_to_remote_hash_expr;
+ arg->next = gfc_get_actual_arglist ();
+ arg = arg->next;
+ arg->expr = send_to_remote_expr;
+ gfc_add_caf_accessor (send_to_remote_hash_expr, send_to_remote_expr);
+}
+
static int
coindexed_expr_callback (gfc_expr **e, int *walk_subtrees,
void *data ATTRIBUTE_UNUSED)
@@ -1158,20 +1442,34 @@ coindexed_code_callback (gfc_code **c, int *walk_subtrees,
*walk_subtrees = 0;
break;
case EXEC_CALL:
- *walk_subtrees
- = !((*c)->resolved_isym
- && ((*c)->resolved_isym->id == GFC_ISYM_CAF_SEND
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_ADD
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_AND
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_CAS
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_DEF
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_FETCH_ADD
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_FETCH_AND
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_FETCH_OR
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_FETCH_XOR
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_OR
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_REF
- || (*c)->resolved_isym->id == GFC_ISYM_ATOMIC_XOR));
+ *walk_subtrees = 1;
+ if ((*c)->resolved_isym)
+ switch ((*c)->resolved_isym->id)
+ {
+ case GFC_ISYM_CAF_SEND:
+ rewrite_caf_send (*c);
+ *walk_subtrees = 0;
+ break;
+ case GFC_ISYM_CAF_SENDGET:
+ // rewrite_caf_sendget (*c);
+ *walk_subtrees = 0;
+ break;
+ case GFC_ISYM_ATOMIC_ADD:
+ case GFC_ISYM_ATOMIC_AND:
+ case GFC_ISYM_ATOMIC_CAS:
+ case GFC_ISYM_ATOMIC_DEF:
+ case GFC_ISYM_ATOMIC_FETCH_ADD:
+ case GFC_ISYM_ATOMIC_FETCH_AND:
+ case GFC_ISYM_ATOMIC_FETCH_OR:
+ case GFC_ISYM_ATOMIC_FETCH_XOR:
+ case GFC_ISYM_ATOMIC_OR:
+ case GFC_ISYM_ATOMIC_REF:
+ case GFC_ISYM_ATOMIC_XOR:
+ *walk_subtrees = 0;
+ break;
+ default:
+ break;
+ }
break;
default:
*walk_subtrees = 1;