diff options
| author | Nicolas KÃnig <koenigni@student.ethz.ch> | 2020-10-18 13:37:30 +0200 |
|---|---|---|
| committer | Nicolas KÃnig <koenigni@student.ethz.ch> | 2020-10-18 13:44:33 +0200 |
| commit | 7488585fc18a9466253617e251c0e0bdc168a3b1 (patch) | |
| tree | 7d0d2faf6c03746ccdd2cf409022ae0d20866751 | |
| parent | b96fdc7b84eb288dea0c3e99a212e6483007a35a (diff) | |
| download | gcc-7488585fc18a9466253617e251c0e0bdc168a3b1.zip gcc-7488585fc18a9466253617e251c0e0bdc168a3b1.tar.gz gcc-7488585fc18a9466253617e251c0e0bdc168a3b1.tar.bz2 | |
Implement comments from review.
This implements the comments from the review - the general prefix is now
cas (for coarray shared), and native has been renamed to shared generally.
Plus, there is a lot of cleanup such as removing dead code and
debug statements.
gcc/ChangeLog:
PR fortran/88076
* flag-types.h (enum gfc_fcoarray): Change GFC_FCOARRAY_NATIVE to
GFC_FCOARRAY_SHARED.
gcc/fortran/ChangeLog:
PR fortran/88076
* dump-parse-tree.c (show_symbol): Remove dumping of backend_decl.
* frontend-passes.c (gfc_run_passes): Generally rename "native" to
"shared" and "cas" instead of "nca".
(co_reduce_code): Initialize num. Generally rename "native" to
"shared" and "cas" instead of "nca".
* gfortran.h: Generally rename "native" to "shared".
* iresolve.c (gfc_resolve_co_collective): Use specific function
for library coarrays. Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_resolve_co_reduce): Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_resolve_co_broadcast): Generally rename "native" to "shared"
and "cas" instead of "nca".
* lang.opt: Generally rename "native" to "shared" and "cas"
instead of "nca".
* resolve.c (fixup_coarray_args): Rename to
(fixup_shared_coarray_args): Generally rename "native" to
"shared" and "cas" instead of "nca". Get rid of a variable.
(resolve_unknown_s): Fix whitespace.
(resolve_call): Generally rename "native" to "shared" and "cas"
instead of "nca".
(resolve_critical): Revert spurious change. Generally rename
"native" to "shared" and "cas" instead of "nca".
* trans-array.c (gfc_add_strides): Fix comment format.
(gfc_native_coarray_add_this_image_offset): Generally rename
"native" to "shared" and "cas" instead of "nca". Formatting
fixes.
(gfc_conv_ss_descriptor): Generally rename "native" to "shared"
and "cas" instead of "nca".
(build_array_ref): Remove empty line.
(gfc_conv_array_ref): Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_array_init_size): Special-case GFC_COARRAY_SHARED. Generally
rename "native" to "shared" and "cas" instead of "nca". Fix
formatting.
(gfc_allocate_native_coarray): Generally rename "native" to
"shared" and "cas" instead of "nca".
(gfc_array_allocate): Generally rename "native" to "shared" and
"cas" instead of "nca". Fix comment syntax.
(gfc_trans_dummy_array_bias): Generally rename "native" to
"shared" and "cas" instead of "nca".
(gfc_get_dataptr_offset): Generally rename "native" to "shared"
and "cas" instead of "nca". Fix comment style.
(gfc_conv_expr_descriptor): Remove code blocks guarded by #if 0 or #if 1.
(gfc_conv_array_parameter): Likewise.
(gfc_walk_array_ref): Likewise.
* trans-array.h (enum gfc_coarray_allocation_type): Change offset from 3 to 1.
* trans-decl.c: Generally rename "native" to "shared" and "cas"
instead of "nca" for tree declarations.
(gfc_build_qualified_array): Generally rename "native" to "shared"
and "cas" instead of "nca".
(gfc_build_dummy_array_decl): Generally rename "native" to "shared"
and "cas" instead of "nca".
(gfc_get_symbol_decl): Revert spurious change. Generally rename
"native" to "shared" and "cas" instead of "nca".
(gfc_build_builtin_function_decls): Generally rename "native" to
"shared" and "cas" instead of "nca".
(gfc_trans_native_coarray): Clarify comment. Generally rename
"native" to "shared" and "cas" instead of "nca".
(gfc_trans_deferred_vars): Generally rename "native" to "shared"
and "cas" instead of "nca".
(gfc_create_module_variable): Generally rename "native" to
"shared" and "cas" instead of "nca".
(generate_coarray_constructor_function): Generally rename "native"
to "shared" and "cas" instead of "nca".
(create_main_function): Generally rename "native" to "shared"
and "cas" instead of "nca".
* trans-expr.c (gfc_maybe_dereference_var): Remove branch where
condition is always false. Generally rename "native" to "shared"
and "cas" instead of "nca".
(gfc_conv_procedure_call): Remove code blocks guarded by #if 0.
Whitespace fix.
* trans-intrinsic.c (trans_this_image): Generally rename "native"
to "shared" and "cas" instead of "nca".
(trans_image_index): Remove unneeded TODO. Generally rename
"native" to "shared" and "cas" instead of "nca".
(trans_num_images): Generally rename "native" to "shared" and
"cas" instead of "nca".
(conv_intrinsic_cobound): Generally rename "native" to "shared"
and "cas" instead of "nca".
(trans_argument): Clarify comment explaining what the function does.
(conv_nca_reduce): Rename to...
(conv_cas_reduce): this. Add comment.
(conv_nca_broadcast): Rename to...
(conv_cas_broadcast): this.
(conv_nca_collective): Rename to...
(conv_cas_collective): this.
(conv_co_collective): Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_conv_intrinsic_subroutine): Generally rename "native" to
"shared" and "cas" instead of "nca".
* trans-stmt.c (gfc_trans_lock_unlock): Generally rename "native"
to "shared" and "cas" instead of "nca".
(gfc_trans_sync): Generally rename "native" to "shared" and "cas"
instead of "nca".
(gfc_trans_critical): Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_trans_deallocate): Generally rename "native" to "shared" and
"cas" instead of "nca".
* trans-types.c (gfc_is_nodesc_array): Generally rename "native"
to "shared" and "cas" instead of "nca".
(gfc_build_array_type): Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_get_nodesc_array_type): Generally rename "native" to "shared"
and "cas" instead of "nca".
(gfc_get_array_type_bounds): Generally rename "native" to "shared"
and "cas" instead of "nca".
* trans.c (gfc_trans_memory_barrier): Use sizeof instead of strlen,
replace comma by semicolon.
(gfc_build_array_ref): Generally rename "native" to "shared" and
"cas" instead of "nca".
(gfc_deallocate_with_status): Fix indentation. Generally rename
"native" to "shared" and "cas" instead of "nca".
* trans.h: Generally rename "native" to "shared" and "cas" instead
of "nca".
libgfortran/ChangeLog:
PR fortran/88076
* m4/nca-minmax-s.m4: Change "nca" prefix to "cas". Add comments.
* m4/nca_minmax.m4: Likewise.
* nca/README.native_coarrays: Update.
* nca/alloc.c (free_memory_with_id): Add FIXME.
* nca/coarraynative.c (nca_master): Rename to
(cas_master): Change logic for exiting images.
* nca/collective_subroutine.c (get_collsub_buf): Add comment.
(collsub_sync): Remove dead debug output.
(collsub_reduce_array): Silence -Wsign-compare warning.
(collsub_iface_init): Remove unused variable.
(collsub_broadcast_scalar): Remove debug code.
(collsub_broadcast_array): Remove unused variable.
(nca_co_broadcast): Remove commented-out function, plus its
(export_proto): prototype declaration.
* nca/collective_subroutine.h (finish_collective_subroutine): Add.
* nca/hashmap.c (num_entries): Silcence -Wsign-compare warning.
(hash): Formatting change (add empty lines).
(gen_mask): Likewise.
(hmiadd): Likewise.
(get_expected_offset): Likewise.
(hashmap_init): Likewise.
(scan_empty): Likewise. Remove unused argument.
(hashmap_get): Formatting change (add empty lines).
(hm_search_result_ptr): Likewise.
(hm_search_result_contains): Likewise.
(enlarge_hashmap_mem): Likewise.
(resize_hm): Likewise. Remove argument in call to scan_empty.
(hashmap_set): Remove dead debugging code. Silence -Wsign-compare
warning.
(hashmap_change_refcnt): Silence -Wsign-compare warning.
(hashmap_inc): Formatting change.
* nca/hashmap.h (Library): Add copyright notice.
* nca/libcoarraynative.h (DEBUG_NATIVE_COARRAY): #define as 0
(NUM_ADDR_BITS): Remove dead code.
(nca_master): Rename to
(cas_master): this.
* nca/shared_memory.c (shared_memory_get_mem_with_alignment):
Remove debug code.
* nca/shared_memory.h (SHARED_MEMORY_H): Move definition to start
of file.
* nca/sync.c (get_locked_table): Remove commented-out code.
(sync_iface_init): Remove debug code.
(sync_all): Remove debug code.
* nca/sync.h: Add space after #include.
* nca/util.c: Include assert.h. Add comment.
(next_power_of_two): Remove comment.
(pack_array_finish): Replace 0 by '\0' in memset.
(unpack_array_finish): Zero variable count.
* nca/wrapper.c (enum gfc_coarray_allocation_type): Enum starts at
one. Add comment about need to keep in sync with trans-array.h.
(nca_coarray_alloc): Rename to
(cas_coarray_alloc): this.
(nca_coarray_free): Rename to
(cas_coarray_free): this.
(nca_coarray_this_image): Rename to
(cas_coarray_this_image): this.
(nca_coarray_num_images): Rename to
(cas_coarray_num_images): this.
(nca_coarray_sync_all): Rename to
(cas_coarray_sync_all): this.
(nca_sync_images): Rename to
(cas_sync_images): this.
(nca_lock): Rename to
(cas_lock): this.
(nca_unlock): Rename to
(cas_unlock): this.
(nca_collsub_reduce_array): Rename to
(cas_collsub_reduce_array): this.
(nca_collsub_reduce_scalar): Rename to
(cas_collsub_reduce_scalar): this.
(nca_collsub_broadcast_array): Rename to
(cas_collsub_broadcast_array): this.
(nca_collsub_broadcast_scalar): Rename to
(cas_collsub_broadcast_scalar): this.
* nca/.tags: Delete.
* nca/collective_inline.h: Delete.
* generated/nca_minmax_i1.c: Regenerated.
* generated/nca_minmax_i16.c: Regenerated.
* generated/nca_minmax_i2.c: Regenerated.
* generated/nca_minmax_i4.c: Regenerated.
* generated/nca_minmax_i8.c: Regenerated.
* generated/nca_minmax_r10.c: Regenerated.
* generated/nca_minmax_r16.c: Regenerated.
* generated/nca_minmax_r4.c: Regenerated.
* generated/nca_minmax_r8.c: Regenerated.
* generated/nca_minmax_s1.c: Regenerated.
* generated/nca_minmax_s4.c: Regenerated.
45 files changed, 670 insertions, 1182 deletions
diff --git a/gcc/flag-types.h b/gcc/flag-types.h index 51e698d..d0659c6 100644 --- a/gcc/flag-types.h +++ b/gcc/flag-types.h @@ -347,7 +347,7 @@ enum gfc_fcoarray GFC_FCOARRAY_NONE = 0, GFC_FCOARRAY_SINGLE, GFC_FCOARRAY_LIB, - GFC_FCOARRAY_NATIVE + GFC_FCOARRAY_SHARED }; diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index acff75a..591df8c 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1060,7 +1060,7 @@ show_symbol (gfc_symbol *sym) if (sym == NULL) return; - fprintf (dumpfile, "|| symbol: '%s' %p ", sym->name, (void *) &(sym->backend_decl)); + fprintf (dumpfile, "|| symbol: '%s'", sym->name); len = strlen (sym->name); for (i=len; i<12; i++) fputc(' ', dumpfile); diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index c573731..df850b0 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -181,7 +181,7 @@ gfc_run_passes (gfc_namespace *ns) if (flag_realloc_lhs) realloc_strings (ns); - if (flag_coarray == GFC_FCOARRAY_NATIVE) + if (flag_coarray == GFC_FCOARRAY_SHARED) rewrite_co_reduce (ns); } @@ -5917,7 +5917,7 @@ co_reduce_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, void *data) gfc_code *assign; gfc_expr *e1, *e2; char name[GFC_MAX_SYMBOL_LEN + 1]; - static int num; + static int num = 0; if (co->op != EXEC_CALL || co->resolved_isym == NULL || co->resolved_isym->id != GFC_ISYM_CO_REDUCE) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6940c24..3629545 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2010,7 +2010,7 @@ typedef struct gfc_array_ref int dimen; /* # of components in the reference */ int codimen; bool in_allocate; /* For coarray checks. */ - bool native_coarray_argument; + bool shared_coarray_arg; gfc_expr *team; gfc_expr *stat; locus where; diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 844891e..1ec3dc5 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -4041,14 +4041,14 @@ gfc_resolve_co_collective (gfc_code *c, const char *oper) gfc_expr *e; const char *name; - if (flag_coarray != GFC_FCOARRAY_NATIVE) - name = gfc_get_string (PREFIX ("caf_co_sum")); + if (flag_coarray != GFC_FCOARRAY_SHARED) + name = gfc_get_string (PREFIX ("caf_co_%s"), oper); else { e = c->ext.actual->expr; kind = e->ts.kind; - name = gfc_get_string (PREFIX ("nca_collsub_%s_%s_%c%d"), oper, + name = gfc_get_string (PREFIX ("cas_collsub_%s_%s_%c%d"), oper, e->rank ? "array" : "scalar", gfc_type_letter (e->ts.type), kind); } @@ -4056,6 +4056,9 @@ gfc_resolve_co_collective (gfc_code *c, const char *oper) c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } +/* All of these are needed, since they are treated seperately in the big + * intrinsic table. */ + /* Resolve CO_SUM. */ void @@ -4088,18 +4091,18 @@ gfc_resolve_co_reduce (gfc_code *c) gfc_expr *e; const char *name; - if (flag_coarray != GFC_FCOARRAY_NATIVE) + if (flag_coarray != GFC_FCOARRAY_SHARED) name = gfc_get_string (PREFIX ("caf_co_reduce")); else { e = c->ext.actual->expr; if (e->ts.type == BT_CHARACTER) - name = gfc_get_string (PREFIX ("nca_collsub_reduce_%s%c%d"), + name = gfc_get_string (PREFIX ("cas_collsub_reduce_%s%c%d"), e->rank ? "array" : "scalar", gfc_type_letter (e->ts.type), e->ts.kind); else - name = gfc_get_string (PREFIX ("nca_collsub_reduce_%s"), + name = gfc_get_string (PREFIX ("cas_collsub_reduce_%s"), e->rank ? "array" : "scalar" ); } @@ -4112,17 +4115,17 @@ gfc_resolve_co_broadcast (gfc_code * c) gfc_expr *e; const char *name; - if (flag_coarray != GFC_FCOARRAY_NATIVE) + if (flag_coarray != GFC_FCOARRAY_SHARED) name = gfc_get_string (PREFIX ("caf_co_broadcast")); else { e = c->ext.actual->expr; if (e->ts.type == BT_CHARACTER) - name = gfc_get_string (PREFIX ("nca_collsub_broadcast_%s%c%d"), + name = gfc_get_string (PREFIX ("cas_collsub_broadcast_%s%c%d"), e->rank ? "array" : "scalar", gfc_type_letter (e->ts.type), e->ts.kind); else - name = gfc_get_string (PREFIX ("nca_collsub_broadcast_%s"), + name = gfc_get_string (PREFIX ("cas_collsub_broadcast_%s"), e->rank ? "array" : "scalar" ); } diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 6180355..063f006 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -776,7 +776,7 @@ EnumValue Enum(gfc_fcoarray) String(lib) Value(GFC_FCOARRAY_LIB) EnumValue -Enum(gfc_fcoarray) String(shared) Value(GFC_FCOARRAY_NATIVE) +Enum(gfc_fcoarray) String(shared) Value(GFC_FCOARRAY_SHARED) fcheck= Fortran RejectNegative JoinedOrMissing diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6d6984b..7d772d5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3585,22 +3585,24 @@ resolve_specific_s (gfc_code *c) return false; } -/* Fix up references to native coarrays in call - element references + +/* Fix up references to shared coarrays in call - element references have to be converted to full references if the coarray has to be passed fully. */ static void -fixup_coarray_args (gfc_symbol *sym, gfc_actual_arglist *actual) +fixup_shared_coarray_args (gfc_symbol *sym, gfc_actual_arglist *actual) { - gfc_formal_arglist *formal, *f; + gfc_formal_arglist *f; gfc_actual_arglist *a; - formal = gfc_sym_get_dummy_args (sym); + a = actual; + f = gfc_sym_get_dummy_args (sym); - if (formal == NULL) + if (f == NULL) return; - for (a = actual, f = formal; a && f; a = a->next, f = f->next) + for (; a && f; a = a->next, f = f->next) { if (a->expr == NULL || f->sym == NULL) continue; @@ -3626,7 +3628,7 @@ fixup_coarray_args (gfc_symbol *sym, gfc_actual_arglist *actual) if (ar->type == AR_ELEMENT) ar->type = !ar->dimen ? AR_FULL : AR_SECTION; - ar->native_coarray_argument = true; + ar->shared_coarray_arg = true; } } } @@ -3662,7 +3664,7 @@ resolve_unknown_s (gfc_code *c) found: gfc_procedure_use (sym, &c->ext.actual, &c->loc); - + c->resolved_sym = sym; return pure_subroutine (sym, sym->name, &c->loc); @@ -3787,8 +3789,8 @@ resolve_call (gfc_code *c) /* Typebound procedure: Assume the worst. */ gfc_current_ns->proc_name->attr.array_outer_dependency = 1; - if (flag_coarray == GFC_FCOARRAY_NATIVE) - fixup_coarray_args (csym, c->ext.actual); + if (flag_coarray == GFC_FCOARRAY_SHARED) + fixup_shared_coarray_args (csym, c->ext.actual); return t; } @@ -10167,7 +10169,7 @@ resolve_critical (gfc_code *code) char name[GFC_MAX_SYMBOL_LEN]; static int serial = 0; - if (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_NATIVE) + if (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_SHARED) return; symtree = gfc_find_symtree (gfc_current_ns->sym_root, @@ -10205,7 +10207,7 @@ resolve_critical (gfc_code *code) NULL, 1); gfc_commit_symbols(); - if (flag_coarray == GFC_FCOARRAY_NATIVE) + if (flag_coarray == GFC_FCOARRAY_SHARED) { gfc_ref *r = gfc_get_ref (); r->type = REF_ARRAY; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 9013f19..55a63e3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2958,9 +2958,9 @@ gfc_add_strides (tree expr, tree desc, int beg, int end) /* This function calculates the new offset via new_offset = offset + this_image () - * arrray.stride[first_codimension] + * array.stride[first_codimension] + sum (remaining codimension offsets) - If offset is a pointer, we also need to multiply it by the size.*/ + If offset is a pointer, we also need to multiply it by the size. */ static tree gfc_native_coarray_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar, int is_pointer, @@ -2968,30 +2968,30 @@ gfc_native_coarray_add_this_image_offset (tree offset, tree desc, { tree tmp, off; /* Calculate the actual offset. */ - tmp = build_call_expr_loc (input_location, gfor_fndecl_nca_this_image, + tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_this_image, 1, integer_zero_node); - tmp = convert (TREE_TYPE(gfc_index_zero_node), tmp); - tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE(tmp), tmp, - build_int_cst (TREE_TYPE(tmp), subtract)); - tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE(tmp), + tmp = convert (TREE_TYPE (gfc_index_zero_node), tmp); + tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp), tmp, + build_int_cst (TREE_TYPE (tmp), subtract)); + tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp), gfc_conv_array_stride (desc, ar->dimen), tmp); /* We also need to add the missing strides once to compensate for the offset, that is to large now. The loop starts at sym->as.rank+1 - because we need to skip the first corank stride */ + because we need to skip the first corank stride. */ off = gfc_add_strides (tmp, desc, ar->as->rank + 1, ar->as->rank + ar->as->corank); if (is_pointer) { - /* Remove pointer and array from type in order to get the raw base type. */ - tmp = TREE_TYPE(TREE_TYPE(TREE_TYPE(offset))); + /* Remove pointer and array from type in order to get the raw base type. */ + tmp = TREE_TYPE (TREE_TYPE (TREE_TYPE (offset))); /* And get the size of that base type. */ - tmp = convert (TREE_TYPE(off), size_in_bytes_loc (input_location, tmp)); - tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE(off), + tmp = convert (TREE_TYPE (off), size_in_bytes_loc (input_location, tmp)); + tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (off), off, tmp); return fold_build_pointer_plus_loc (input_location, offset, tmp); } else - return fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE(offset), + return fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (offset), offset, off); } @@ -3040,7 +3040,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) /* If we have a native coarray with implied this_image (), add the appropriate offset to the data pointer. */ ref = ss_info->expr->ref; - if (flag_coarray == GFC_FCOARRAY_NATIVE && ref + if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1] == DIMEN_THIS_IMAGE) tmp = gfc_native_coarray_add_this_image_offset (tmp, se.expr, &ref->u.ar, 1, 1); @@ -3060,7 +3060,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) offset for the codimensions. */ // TODO: check whether the recipient is a coarray, if it is, disable // all of this - if (flag_coarray == GFC_FCOARRAY_NATIVE && ref + if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1] == DIMEN_THIS_IMAGE) tmp = gfc_add_strides (tmp, se.expr, ref->u.ar.as->rank, @@ -3665,7 +3665,6 @@ build_array_ref (tree desc, tree offset, tree decl, tree vptr) } - /* Build an array reference. se->expr already holds the array descriptor. This should be either a variable, indirect variable reference or component reference. For arrays which do not have a descriptor, se->expr will be @@ -3685,20 +3684,21 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, gfc_se tmpse; gfc_symbol * sym = expr->symtree->n.sym; char *var_name = NULL; + /* True if the base needs the implied image offset. */ bool need_impl_this_image; int eff_dimen; need_impl_this_image = ar->dimen_type[ar->dimen + ar->codimen - 1] == DIMEN_THIS_IMAGE; - if (flag_coarray == GFC_FCOARRAY_NATIVE + if (flag_coarray == GFC_FCOARRAY_SHARED && !need_impl_this_image) eff_dimen = ar->dimen + ar->codimen - 1; else eff_dimen = ar->dimen - 1; - if (flag_coarray != GFC_FCOARRAY_NATIVE && ar->dimen == 0) + if (flag_coarray != GFC_FCOARRAY_SHARED && ar->dimen == 0) { gcc_assert (ar->codimen || sym->attr.select_rank_temporary || (ar->as && ar->as->corank)); @@ -3838,7 +3838,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, add_to_offset (&cst_offset, &offset, tmp); } - if (flag_coarray == GFC_FCOARRAY_NATIVE && need_impl_this_image) + if (flag_coarray == GFC_FCOARRAY_SHARED && need_impl_this_image) offset = gfc_native_coarray_add_this_image_offset (offset, se->expr, ar, 0, 0); if (!integer_zerop (cst_offset)) @@ -5584,6 +5584,10 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, for (n = 0; n < rank; n++) { + + if (flag_coarray != GFC_FCOARRAY_SHARED) + conv_lbound = conv_ubound = NULL_TREE; + /* We have 3 possibilities for determining the size of the array: lower == NULL => lbound = 1, ubound = upper[n] upper[n] = NULL => lbound = 1, ubound = lower[n] @@ -5734,7 +5738,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, gfc_conv_descriptor_lbound_set (descriptor_block, descriptor, gfc_rank_cst[n], se.expr); conv_lbound = se.expr; - if (flag_coarray == GFC_FCOARRAY_NATIVE) + if (flag_coarray == GFC_FCOARRAY_SHARED) { tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, @@ -5751,14 +5755,18 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, gfc_add_block_to_block (pblock, &se.pre); gfc_conv_descriptor_ubound_set (descriptor_block, descriptor, gfc_rank_cst[n], se.expr); - gfc_conv_descriptor_stride_set (descriptor_block, descriptor, - gfc_rank_cst[n], stride); + if (flag_coarray == GFC_FCOARRAY_SHARED) + /* It is unclear why we don't need this in for -fcoarray=lib, + but since the addition of shared coarrays should not change + the semantics, it's inside this if. */ + gfc_conv_descriptor_stride_set (descriptor_block, descriptor, + gfc_rank_cst[n], stride); conv_ubound = se.expr; - if (flag_coarray == GFC_FCOARRAY_NATIVE) + if (flag_coarray == GFC_FCOARRAY_SHARED) { - size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, + size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &or_expr); - size = gfc_evaluate_now (size, descriptor_block); + size = gfc_evaluate_now (size, descriptor_block); stride = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, stride, size); stride = gfc_evaluate_now (stride, descriptor_block); @@ -5796,7 +5804,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, /* Convert to size_t. */ *element_size = fold_convert (size_type_node, tmp); - if (rank == 0 && !(flag_coarray == GFC_FCOARRAY_NATIVE && corank)) + if (rank == 0 && !(flag_coarray == GFC_FCOARRAY_SHARED && corank)) return *element_size; *nelems = gfc_evaluate_now (stride, pblock); @@ -5906,7 +5914,7 @@ gfc_allocate_native_coarray (stmtblock_t *b, tree decl, tree size, int corank, int alloc_type) { gfc_add_expr_to_block (b, - build_call_expr_loc (input_location, gfor_fndecl_nca_coarray_allocate, + build_call_expr_loc (input_location, gfor_fndecl_cas_coarray_allocate, 4, gfc_build_addr_expr (pvoid_type_node, decl), size, build_int_cst (integer_type_node, corank), build_int_cst (integer_type_node, alloc_type))); @@ -6055,7 +6063,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, expr3_elem_size, nelems, expr3, e3_arr_desc, e3_has_nodescriptor, expr, &element_size); - if (dimension || (flag_coarray == GFC_FCOARRAY_NATIVE && coarray)) + if (dimension || (flag_coarray == GFC_FCOARRAY_SHARED && coarray)) { var_overflow = gfc_create_var (integer_type_node, "overflow"); gfc_add_modify (&se->pre, var_overflow, overflow); @@ -6097,7 +6105,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, pointer = gfc_conv_descriptor_data_get (se->expr); STRIP_NOPS (pointer); - if (allocatable && !(flag_coarray == GFC_FCOARRAY_NATIVE && coarray)) + if (allocatable && !(flag_coarray == GFC_FCOARRAY_SHARED && coarray)) { not_prev_allocated = gfc_create_var (logical_type_node, "not_prev_allocated"); @@ -6110,7 +6118,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_start_block (&elseblock); - if (coarray && flag_coarray == GFC_FCOARRAY_NATIVE) + if (coarray && flag_coarray == GFC_FCOARRAY_SHARED) { tree elem_size = size_in_bytes (gfc_get_element_type (TREE_TYPE(se->expr))); @@ -6170,9 +6178,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, build_empty_stmt (input_location)); } - // For native coarrays, the size must be set before the allocation routine - // can be called. - if (coarray && flag_coarray == GFC_FCOARRAY_NATIVE) + /* For native coarrays, the size must be set before the allocation routine + can be called. */ + if (coarray && flag_coarray == GFC_FCOARRAY_SHARED) { gfc_add_expr_to_block (&se->pre, set_descriptor); gfc_add_expr_to_block (&se->pre, allocation); @@ -6800,7 +6808,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, offset = gfc_index_zero_node; size = gfc_index_one_node; - if (flag_coarray == GFC_FCOARRAY_NATIVE) + if (flag_coarray == GFC_FCOARRAY_SHARED) eff_dimen = as->rank + as->corank; else eff_dimen = as->rank; @@ -7046,12 +7054,12 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, return; } - /* if it's a coarray with implicit this_image, add that to the offset. */ + /* If it's a coarray with implicit this_image, add that to the offset. */ ref = expr->ref; - if (flag_coarray == GFC_FCOARRAY_NATIVE && ref && ref->type == REF_ARRAY + if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->type == REF_ARRAY && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1] == DIMEN_THIS_IMAGE - && !ref->u.ar.native_coarray_argument) + && !ref->u.ar.shared_coarray_arg) offset = gfc_native_coarray_add_this_image_offset (offset, desc, &ref->u.ar, 0, 1); @@ -7061,7 +7069,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, subreferences; e.g. my_integer => my_type(:)%integer_component. */ if (subref) { - /* Go past the array reference. */ + /* Go past the array reference. */ for (ref = expr->ref; ref; ref = ref->next) { if (ref->type == REF_ARRAY && @@ -7070,7 +7078,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, ref = ref->next; break; } - else if (flag_coarray == GFC_FCOARRAY_NATIVE && ref->type == REF_ARRAY && + else if (flag_coarray == GFC_FCOARRAY_SHARED && ref->type == REF_ARRAY && ref->u.ar.dimen_type[ref->u.ar.dimen +ref->u.ar.codimen -1] == DIMEN_THIS_IMAGE) tmp = gfc_native_coarray_add_this_image_offset (tmp, desc, &ref->u.ar, 0, 1); @@ -7137,8 +7145,8 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, gfc_array_index_type, stride, itmp); stride = gfc_evaluate_now (stride, block); } - if (flag_coarray == GFC_FCOARRAY_NATIVE && - ref->u.ar.dimen_type[ref->u.ar.dimen +ref->u.ar.codimen -1] + if (flag_coarray == GFC_FCOARRAY_SHARED && + ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen -1] == DIMEN_THIS_IMAGE) tmp = gfc_native_coarray_add_this_image_offset (tmp, desc, &ref->u.ar, 0, 1); /* Apply the index to obtain the array element. */ @@ -7491,7 +7499,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) else full = gfc_full_array_ref_p (info->ref, NULL); - if (flag_coarray == GFC_FCOARRAY_NATIVE && + if (flag_coarray == GFC_FCOARRAY_SHARED && info->ref->type == REF_ARRAY && info->ref->u.ar.dimen_type[info->ref->u.ar.dimen + info->ref->u.ar.codimen - 1] == @@ -7732,19 +7740,17 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tree to; tree base; tree offset; -#if 0 /* TK */ - ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen; -#else + if (info->ref) { - if (info->ref->u.ar.native_coarray_argument) + if (info->ref->u.ar.shared_coarray_arg) ndim = info->ref->u.ar.dimen + info->ref->u.ar.codimen; else ndim = info->ref->u.ar.dimen; } else ndim = ss->dimen; -#endif + if (se->want_coarray) { gfc_array_ref *ar = &info->ref->u.ar; @@ -8113,15 +8119,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, expr->ts.u.cl->backend_decl = tmp; se->string_length = tmp; } -#if 0 - if (flag_coarray == GFC_FCOARRAY_NATIVE && fsym && fsym->attr.codimension && sym) - { - gfc_init_se (se, NULL); - tmp = gfc_get_symbol_decl (sym); - se->expr = gfc_build_addr_expr (NULL_TREE, tmp); - return; - } -#endif + /* Is this the result of the enclosing procedure? */ this_array_result = (full_array_var && sym->attr.flavor == FL_PROCEDURE); if (this_array_result @@ -8129,10 +8127,9 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, && (sym->backend_decl != parent)) this_array_result = false; -#if 1 /* TK */ - if (flag_coarray == GFC_FCOARRAY_NATIVE && fsym && fsym->attr.codimension) + if (flag_coarray == GFC_FCOARRAY_SHARED && fsym && fsym->attr.codimension) g77 = false; -#endif + /* Passing address of the array if it is not pointer or assumed-shape. */ if (full_array_var && g77 && !this_array_result && sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS) @@ -11083,13 +11080,13 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case AR_SECTION: newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION); newss->info->data.array.ref = ref; -#if 1 /* TK */ + int eff_dimen; - if (ar->native_coarray_argument) + if (ar->shared_coarray_arg) eff_dimen = ar->dimen + ar->codimen; else eff_dimen = ar->dimen; -#endif + /* We add SS chains for all the subscripts in the section. */ for (n = 0; n < eff_dimen; n++) { diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 0bfd1b0..d0b05aa 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -24,10 +24,11 @@ bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree, tree, tree *, gfc_expr *, tree, bool); enum gfc_coarray_allocation_type { - GFC_NCA_NORMAL_COARRAY = 3, + GFC_NCA_NORMAL_COARRAY = 1, GFC_NCA_LOCK_COARRAY, GFC_NCA_EVENT_COARRAY }; + int gfc_native_coarray_get_allocation_type (gfc_symbol *); void gfc_allocate_native_coarray (stmtblock_t *, tree, tree, int, int); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 5eadf40..3b5bf0c 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -172,19 +172,19 @@ tree gfor_fndecl_caf_is_present; /* Native coarray functions. */ -tree gfor_fndecl_nca_master; -tree gfor_fndecl_nca_coarray_allocate; -tree gfor_fndecl_nca_coarray_free; -tree gfor_fndecl_nca_this_image; -tree gfor_fndecl_nca_num_images; -tree gfor_fndecl_nca_sync_all; -tree gfor_fndecl_nca_sync_images; -tree gfor_fndecl_nca_lock; -tree gfor_fndecl_nca_unlock; -tree gfor_fndecl_nca_reduce_scalar; -tree gfor_fndecl_nca_reduce_array; -tree gfor_fndecl_nca_broadcast_scalar; -tree gfor_fndecl_nca_broadcast_array; +tree gfor_fndecl_cas_master; +tree gfor_fndecl_cas_coarray_allocate; +tree gfor_fndecl_cas_coarray_free; +tree gfor_fndecl_cas_this_image; +tree gfor_fndecl_cas_num_images; +tree gfor_fndecl_cas_sync_all; +tree gfor_fndecl_cas_sync_images; +tree gfor_fndecl_cas_lock; +tree gfor_fndecl_cas_unlock; +tree gfor_fndecl_cas_reduce_scalar; +tree gfor_fndecl_cas_reduce_array; +tree gfor_fndecl_cas_broadcast_scalar; +tree gfor_fndecl_cas_broadcast_array; /* Math functions. Many other math functions are handled in trans-intrinsic.c. */ @@ -1048,7 +1048,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) gfc_add_decl_to_function (token); } - eff_dimen = flag_coarray == GFC_FCOARRAY_NATIVE + eff_dimen = flag_coarray == GFC_FCOARRAY_SHARED ? GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type) : GFC_TYPE_ARRAY_RANK (type); @@ -1075,7 +1075,11 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) } } - if (flag_coarray != GFC_FCOARRAY_NATIVE) + /* We don't need the following code in shared coarray mode, since the + dimensions are handled the usual way in the loop above + (eff_dimen = dimen + codimen). */ + + if (flag_coarray != GFC_FCOARRAY_SHARED) for (dim = GFC_TYPE_ARRAY_RANK (type); dim < GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type); dim++) @@ -1230,7 +1234,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) || (as && as->type == AS_ASSUMED_RANK)) return dummy; - if (flag_coarray == GFC_FCOARRAY_NATIVE && sym->attr.codimension + if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension && sym->attr.allocatable) return dummy; @@ -1851,7 +1855,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) } /* Remember this variable for allocation/cleanup. */ - if (sym->attr.dimension || sym->attr.codimension || sym->attr.allocatable + if (sym->attr.dimension || sym->attr.allocatable || sym->attr.codimension || (sym->ts.type == BT_CLASS && (CLASS_DATA (sym)->attr.dimension || CLASS_DATA (sym)->attr.allocatable)) @@ -1900,7 +1904,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL); } - if (flag_coarray == GFC_FCOARRAY_NATIVE && sym->attr.codimension) + if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension) TREE_STATIC(decl) = 1; gfc_finish_var_decl (decl, sym); @@ -4096,65 +4100,65 @@ gfc_build_builtin_function_decls (void) integer_type_node, 3, pvoid_type_node, integer_type_node, pvoid_type_node); } - else if (flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_SHARED) { - gfor_fndecl_nca_master = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_master")), ".r", integer_type_node, 1, + gfor_fndecl_cas_master = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_master")), ".r", integer_type_node, 1, build_pointer_type (build_function_type_list (void_type_node, NULL_TREE))); - gfor_fndecl_nca_coarray_allocate = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_coarray_alloc")), "..RRR", integer_type_node, 4, + gfor_fndecl_cas_coarray_allocate = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_coarray_alloc")), "..RRR", integer_type_node, 4, pvoid_type_node, integer_type_node, integer_type_node, integer_type_node, NULL_TREE); - gfor_fndecl_nca_coarray_free = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_coarray_free")), "..R", integer_type_node, 2, + gfor_fndecl_cas_coarray_free = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_coarray_free")), "..R", integer_type_node, 2, pvoid_type_node, /* Pointer to the descriptor to be deallocated. */ integer_type_node, /* Type of allocation (normal, event, lock). */ NULL_TREE); - gfor_fndecl_nca_this_image = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_coarray_this_image")), ".X", integer_type_node, 1, + gfor_fndecl_cas_this_image = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_coarray_this_image")), ".X", integer_type_node, 1, integer_type_node, /* This is the team number. Currently ignored. */ NULL_TREE); - DECL_PURE_P (gfor_fndecl_nca_this_image) = 1; - gfor_fndecl_nca_num_images = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_coarray_num_images")), ".X", integer_type_node, 1, + DECL_PURE_P (gfor_fndecl_cas_this_image) = 1; + gfor_fndecl_cas_num_images = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_coarray_num_images")), ".X", integer_type_node, 1, integer_type_node, /* See above. */ NULL_TREE); - DECL_PURE_P (gfor_fndecl_nca_num_images) = 1; - gfor_fndecl_nca_sync_all = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_coarray_sync_all")), ".X", void_type_node, 1, + DECL_PURE_P (gfor_fndecl_cas_num_images) = 1; + gfor_fndecl_cas_sync_all = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_coarray_sync_all")), ".X", void_type_node, 1, build_pointer_type (integer_type_node), NULL_TREE); - gfor_fndecl_nca_sync_images = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_sync_images")), ".RRXXX", void_type_node, + gfor_fndecl_cas_sync_images = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_sync_images")), ".RRXXX", void_type_node, 5, integer_type_node, pint_type, pint_type, pchar_type_node, size_type_node, NULL_TREE); - gfor_fndecl_nca_lock = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_lock")), ".w", void_type_node, 1, + gfor_fndecl_cas_lock = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_lock")), ".w", void_type_node, 1, pvoid_type_node, NULL_TREE); - gfor_fndecl_nca_unlock = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_unlock")), ".w", void_type_node, 1, + gfor_fndecl_cas_unlock = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("cas_unlock")), ".w", void_type_node, 1, pvoid_type_node, NULL_TREE); - gfor_fndecl_nca_reduce_scalar = + gfor_fndecl_cas_reduce_scalar = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_collsub_reduce_scalar")), ".wrW", + get_identifier (PREFIX("cas_collsub_reduce_scalar")), ".wrW", void_type_node, 3, pvoid_type_node, build_pointer_type (build_function_type_list (void_type_node, pvoid_type_node, pvoid_type_node, NULL_TREE)), pint_type, NULL_TREE); - gfor_fndecl_nca_reduce_array = + gfor_fndecl_cas_reduce_array = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX("nca_collsub_reduce_array")), ".wrWR", + get_identifier (PREFIX("cas_collsub_reduce_array")), ".wrWR", void_type_node, 4, pvoid_type_node, build_pointer_type (build_function_type_list (void_type_node, pvoid_type_node, pvoid_type_node, NULL_TREE)), pint_type, integer_type_node, NULL_TREE); - gfor_fndecl_nca_broadcast_scalar = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX ("nca_collsub_broadcast_scalar")), ".w..", + gfor_fndecl_cas_broadcast_scalar = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX ("cas_collsub_broadcast_scalar")), ".w..", void_type_node, 3, pvoid_type_node, size_type_node, integer_type_node); - gfor_fndecl_nca_broadcast_array = gfc_build_library_function_decl_with_spec ( - get_identifier (PREFIX ("nca_collsub_broadcast_array")), ".W.", + gfor_fndecl_cas_broadcast_array = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX ("cas_collsub_broadcast_array")), ".W.", void_type_node, 2, pvoid_type_node, integer_type_node); } @@ -4638,7 +4642,8 @@ void gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * sym) { tree tmp, decl; - tree overflow = build_int_cst (integer_type_node, 0), nelems, element_size; //All unused + /* All unused, but needed as arguments. */ + tree overflow = build_int_cst (integer_type_node, 0), nelems, element_size; tree offset; tree elem_size; int alloc_type; @@ -4665,7 +4670,7 @@ gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * if (cleanup) { - tmp = build_call_expr_loc (input_location, gfor_fndecl_nca_coarray_free, + tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_coarray_free, 2, gfc_build_addr_expr (pvoid_type_node, decl), build_int_cst (integer_type_node, alloc_type)); gfc_add_expr_to_block (cleanup, tmp); @@ -4997,7 +5002,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_trans_deferred_array (sym, block); } } - else if (flag_coarray != GFC_FCOARRAY_NATIVE + else if (flag_coarray != GFC_FCOARRAY_SHARED && sym->attr.codimension && TREE_STATIC (sym->backend_decl)) { @@ -5008,7 +5013,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) NULL_TREE); continue; } - else if (flag_coarray == GFC_FCOARRAY_NATIVE + else if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension) { gfc_trans_native_coarray_inline (block, sym); @@ -5504,7 +5509,7 @@ gfc_create_module_variable (gfc_symbol * sym) DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl; rest_of_decl_compilation (decl, 1, 0); - if (flag_coarray == GFC_FCOARRAY_NATIVE && sym->attr.codimension + if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension && !sym->attr.allocatable) gfc_trans_native_coarray_static (sym); @@ -5916,7 +5921,7 @@ generate_coarray_constructor_function (tree *save_fn_decl, tree *fndecl) tmp = build_function_type_list (void_type_node, NULL_TREE); *fndecl = build_decl (input_location, FUNCTION_DECL, - create_tmp_var_name (flag_coarray == GFC_FCOARRAY_LIB ? "_caf_init" : "_nca_init"), tmp); + create_tmp_var_name (flag_coarray == GFC_FCOARRAY_LIB ? "_caf_init" : "_cas_init"), tmp); DECL_STATIC_CONSTRUCTOR (*fndecl) = 1; SET_DECL_INIT_PRIORITY (*fndecl, DEFAULT_INIT_PRIORITY); @@ -6663,8 +6668,8 @@ create_main_function (tree fndecl) } /* Call MAIN__(). */ - if (flag_coarray == GFC_FCOARRAY_NATIVE) - tmp = build_call_expr_loc (input_location, gfor_fndecl_nca_master, 1, + if (flag_coarray == GFC_FCOARRAY_SHARED) + tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_master, 1, gfc_build_addr_expr (NULL, fndecl)); else tmp = build_call_expr_loc (input_location, diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9979980..e6385be2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2623,13 +2623,8 @@ gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p, else if (!sym->attr.value) { - /* Do not derefernce native coarray dummies. */ - if (false && flag_coarray == GFC_FCOARRAY_NATIVE - && sym->attr.codimension && sym->attr.dummy) - return var; - /* Dereference temporaries for class array dummy arguments. */ - else if (sym->attr.dummy && is_classarray + if (sym->attr.dummy && is_classarray && GFC_ARRAY_TYPE_P (TREE_TYPE (var))) { if (!descriptor_only_p) @@ -2641,7 +2636,7 @@ gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p, /* Dereference non-character scalar dummy arguments. */ if (sym->attr.dummy && !sym->attr.dimension && !(sym->attr.codimension && sym->attr.allocatable) - && !(sym->attr.codimension && flag_coarray == GFC_FCOARRAY_NATIVE) + && !(sym->attr.codimension && flag_coarray == GFC_FCOARRAY_SHARED) && (sym->ts.type != BT_CLASS || (!CLASS_DATA (sym)->attr.dimension && !(CLASS_DATA (sym)->attr.codimension @@ -5536,10 +5531,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, nodesc_arg = nodesc_arg || !comp->attr.always_explicit; else nodesc_arg = nodesc_arg || !sym->attr.always_explicit; -#if 0 - if (flag_coarray == GFC_FCOARRAY_NATIVE && fsym->attr.codimension) - nodesc_arg = false; -#endif + /* Class array expressions are sometimes coming completely unadorned with either arrayspec or _data component. Correct that here. OOP-TODO: Move this to the frontend. */ @@ -5731,10 +5723,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, parmse.want_coarray = 1; scalar = false; } -#if 0 - if (flag_coarray == GFC_FCOARRAY_NATIVE && fsym->attr.codimension) - scalar = false; -#endif + /* A scalar or transformational function. */ if (scalar) { @@ -6247,7 +6236,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym, sym->name, NULL); - + /* Unallocated allocatable arrays and unassociated pointer arrays need their dtype setting if they are argument associated with assumed rank dummies. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index b418321..2f58ce7 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2395,8 +2395,8 @@ trans_this_image (gfc_se * se, gfc_expr *expr) else tmp = integer_zero_node; tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE ? - gfor_fndecl_nca_this_image : + flag_coarray == GFC_FCOARRAY_SHARED ? + gfor_fndecl_cas_this_image : gfor_fndecl_caf_this_image, 1, tmp); se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), @@ -2405,7 +2405,6 @@ trans_this_image (gfc_se * se, gfc_expr *expr) } /* Coarray-argument version: THIS_IMAGE(coarray [, dim]). */ - /* TODO: NCA handle native coarrays. */ type = gfc_get_int_type (gfc_default_integer_kind); corank = gfc_get_corank (expr->value.function.actual->expr); @@ -2495,8 +2494,8 @@ trans_this_image (gfc_se * se, gfc_expr *expr) /* this_image () - 1. */ tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE - ? gfor_fndecl_nca_this_image + flag_coarray == GFC_FCOARRAY_SHARED + ? gfor_fndecl_cas_this_image : gfor_fndecl_caf_this_image, 1, integer_zero_node); tmp = fold_build2_loc (input_location, MINUS_EXPR, type, @@ -2782,8 +2781,8 @@ trans_image_index (gfc_se * se, gfc_expr *expr) else { tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE - ? gfor_fndecl_nca_num_images + flag_coarray == GFC_FCOARRAY_SHARED + ? gfor_fndecl_cas_num_images : gfor_fndecl_caf_num_images, 2, integer_zero_node, build_int_cst (integer_type_node, -1)); @@ -2830,8 +2829,8 @@ trans_num_images (gfc_se * se, gfc_expr *expr) else failed = build_int_cst (integer_type_node, -1); - if (flag_coarray == GFC_FCOARRAY_NATIVE) - tmp = build_call_expr_loc (input_location, gfor_fndecl_nca_num_images, 1, + if (flag_coarray == GFC_FCOARRAY_SHARED) + tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_num_images, 1, distance); else tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2, @@ -3280,8 +3279,8 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank); tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE - ? gfor_fndecl_nca_num_images + flag_coarray == GFC_FCOARRAY_SHARED + ? gfor_fndecl_cas_num_images : gfor_fndecl_caf_num_images, 2, integer_zero_node, build_int_cst (integer_type_node, -1)); @@ -3299,8 +3298,9 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) { /* ubound = lbound + num_images() - 1. */ tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE ? gfor_fndecl_nca_num_images : - gfor_fndecl_caf_num_images, + flag_coarray == GFC_FCOARRAY_SHARED + ? gfor_fndecl_cas_num_images + : gfor_fndecl_caf_num_images, 2, integer_zero_node, build_int_cst (integer_type_node, -1)); tmp = fold_build2_loc (input_location, MINUS_EXPR, @@ -11024,7 +11024,8 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, } } -/* Helper function - advance to the next argument. */ +/* Helper function - translate an argument and advance to the next. + Coarrays are irrelevant here, since we just translate normal arguments. */ static tree trans_argument (gfc_actual_arglist **curr_al, stmtblock_t *blk, @@ -11045,7 +11046,7 @@ trans_argument (gfc_actual_arglist **curr_al, stmtblock_t *blk, /* Convert CO_REDUCE for native coarrays. */ static tree -conv_nca_reduce (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) +conv_cas_reduce (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) { gfc_actual_arglist *curr_al; tree var, reduce_op, result_image, elem_size; @@ -11054,6 +11055,8 @@ conv_nca_reduce (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) curr_al = code->ext.actual; + /* We cannot move the gfc_init_se treatment into trans_argument, because we + cannot be sure that we want a pointer. */ gfc_init_se (&argse, NULL); argse.want_pointer = 1; is_array = curr_al->expr->rank > 0; @@ -11069,16 +11072,16 @@ conv_nca_reduce (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) null_pointer_node); if (is_array) - return build_call_expr_loc (input_location, gfor_fndecl_nca_reduce_array, + return build_call_expr_loc (input_location, gfor_fndecl_cas_reduce_array, 3, var, reduce_op, result_image); elem_size = size_in_bytes(TREE_TYPE(TREE_TYPE(var))); - return build_call_expr_loc (input_location, gfor_fndecl_nca_reduce_scalar, 4, + return build_call_expr_loc (input_location, gfor_fndecl_cas_reduce_scalar, 4, var, elem_size, reduce_op, result_image); } static tree -conv_nca_broadcast (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) +conv_cas_broadcast (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) { gfc_actual_arglist *curr_al; tree var, source_image, elem_size; @@ -11097,11 +11100,11 @@ conv_nca_broadcast (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk) source_image = trans_argument (&curr_al, blk, postblk, &argse, NULL_TREE); if (is_array) - return build_call_expr_loc (input_location, gfor_fndecl_nca_broadcast_array, + return build_call_expr_loc (input_location, gfor_fndecl_cas_broadcast_array, 2, var, source_image); elem_size = size_in_bytes(TREE_TYPE(TREE_TYPE(var))); - return build_call_expr_loc (input_location, gfor_fndecl_nca_broadcast_scalar, + return build_call_expr_loc (input_location, gfor_fndecl_cas_broadcast_scalar, 3, var, elem_size, source_image); } @@ -11110,7 +11113,7 @@ static tree conv_co_collective (gfc_code *); /* Convert collective subroutines for native coarrays. */ static tree -conv_nca_collective (gfc_code *code) +conv_cas_collective (gfc_code *code) { switch (code->resolved_isym->id) @@ -11122,11 +11125,12 @@ conv_nca_collective (gfc_code *code) gfc_start_block (&block); gfc_init_block (&postblock); - fcall = conv_nca_reduce (code, &block, &postblock); + fcall = conv_cas_reduce (code, &block, &postblock); gfc_add_expr_to_block (&block, fcall); gfc_add_block_to_block (&block, &postblock); return gfc_finish_block (&block); } + case GFC_ISYM_CO_SUM: case GFC_ISYM_CO_MIN: case GFC_ISYM_CO_MAX: @@ -11139,15 +11143,12 @@ conv_nca_collective (gfc_code *code) gfc_start_block (&block); gfc_init_block (&postblock); - fcall = conv_nca_broadcast (code, &block, &postblock); + fcall = conv_cas_broadcast (code, &block, &postblock); gfc_add_expr_to_block (&block, fcall); gfc_add_block_to_block (&block, &postblock); return gfc_finish_block (&block); } -#if 0 - case GFC_ISYM_CO_BROADCAST: - return conv_co_collective (code); -#endif + default: gfc_internal_error ("Invalid or unsupported isym"); break; @@ -11264,7 +11265,7 @@ conv_co_collective (gfc_code *code) /* For native coarrays, we only come here for CO_BROADCAST. */ gcc_assert (code->resolved_isym->id == GFC_ISYM_CO_BROADCAST - || flag_coarray != GFC_FCOARRAY_NATIVE); + || flag_coarray != GFC_FCOARRAY_SHARED); /* Generate the function call. */ @@ -12260,8 +12261,8 @@ gfc_conv_intrinsic_subroutine (gfc_code *code) case GFC_ISYM_CO_MAX: case GFC_ISYM_CO_REDUCE: case GFC_ISYM_CO_SUM: - if (flag_coarray == GFC_FCOARRAY_NATIVE) - res = conv_nca_collective (code); + if (flag_coarray == GFC_FCOARRAY_SHARED) + res = conv_cas_collective (code); else res = conv_co_collective (code); break; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 4897fa1..67cba1d 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -832,7 +832,7 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op) return early. (ERRMSG= is always untouched for -fcoarray=single.) */ if (!code->expr2 && !code->expr4 && !(flag_coarray == GFC_FCOARRAY_LIB - || flag_coarray == GFC_FCOARRAY_NATIVE)) + || flag_coarray == GFC_FCOARRAY_SHARED)) return NULL_TREE; if (code->expr2) @@ -992,7 +992,7 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op) return gfc_finish_block (&se.pre); } - else if (flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_SHARED) { gfc_se arg; stmtblock_t res; @@ -1004,8 +1004,8 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op) gfc_conv_expr (&arg, code->expr1); gfc_add_block_to_block (&res, &arg.pre); call = build_call_expr_loc (input_location, op == EXEC_LOCK ? - gfor_fndecl_nca_lock - : gfor_fndecl_nca_unlock, + gfor_fndecl_cas_lock + : gfor_fndecl_cas_unlock, 1, fold_convert (pvoid_type_node, gfc_build_addr_expr (NULL, arg.expr))); gfc_add_expr_to_block (&res, call); @@ -1209,7 +1209,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) return early. (ERRMSG= is always untouched for -fcoarray=single.) */ if (!code->expr2 && !(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && flag_coarray != GFC_FCOARRAY_LIB - && flag_coarray != GFC_FCOARRAY_NATIVE) + && flag_coarray != GFC_FCOARRAY_SHARED) return NULL_TREE; gfc_init_se (&se, NULL); @@ -1232,7 +1232,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) else stat = null_pointer_node; - if (code->expr3 && (flag_coarray == GFC_FCOARRAY_LIB || flag_coarray == GFC_FCOARRAY_NATIVE)) + if (code->expr3 && (flag_coarray == GFC_FCOARRAY_LIB || flag_coarray == GFC_FCOARRAY_SHARED)) { gcc_assert (code->expr3->expr_type == EXPR_VARIABLE); gfc_init_se (&argse, NULL); @@ -1242,7 +1242,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) errmsg = gfc_build_addr_expr (NULL, argse.expr); errmsglen = fold_convert (size_type_node, argse.string_length); } - else if (flag_coarray == GFC_FCOARRAY_LIB || flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_LIB || flag_coarray == GFC_FCOARRAY_SHARED) { errmsg = null_pointer_node; errmsglen = build_int_cst (size_type_node, 0); @@ -1255,7 +1255,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) { tree images2 = fold_convert (integer_type_node, images); tree cond; - if (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_NATIVE) + if (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_SHARED) cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, images, build_int_cst (TREE_TYPE (images), 1)); else @@ -1279,13 +1279,13 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) /* Per F2008, 8.5.1, a SYNC MEMORY is implied by calling the image control statements SYNC IMAGES and SYNC ALL. */ - if (flag_coarray == GFC_FCOARRAY_LIB || flag_coarray == GFC_FCOARRAY_NATIVE) + if (flag_coarray == GFC_FCOARRAY_LIB || flag_coarray == GFC_FCOARRAY_SHARED) { tmp = gfc_trans_memory_barrier (); gfc_add_expr_to_block (&se.pre, tmp); } - if (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_NATIVE) + if (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_SHARED) { /* Set STAT to zero. */ if (code->expr2) @@ -1312,7 +1312,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, 3, stat, errmsg, errmsglen); else - tmp = build_call_expr_loc (input_location, gfor_fndecl_nca_sync_all, + tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_sync_all, 1, stat); } @@ -1380,8 +1380,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) stat = gfc_build_addr_expr (NULL, stat); tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE - ? gfor_fndecl_nca_sync_images + flag_coarray == GFC_FCOARRAY_SHARED + ? gfor_fndecl_cas_sync_images : gfor_fndecl_caf_sync_images, 5, fold_convert (integer_type_node, len), images, stat, errmsg, errmsglen); @@ -1392,8 +1392,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) tree tmp_stat = gfc_create_var (integer_type_node, "stat"); tmp = build_call_expr_loc (input_location, - flag_coarray == GFC_FCOARRAY_NATIVE - ? gfor_fndecl_nca_sync_images + flag_coarray == GFC_FCOARRAY_SHARED + ? gfor_fndecl_cas_sync_images : gfor_fndecl_caf_sync_images, 5, fold_convert (integer_type_node, len), images, gfc_build_addr_expr (NULL, tmp_stat), @@ -1630,7 +1630,7 @@ gfc_trans_critical (gfc_code *code) gfc_add_expr_to_block (&block, tmp); } - else if (flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_SHARED) { tmp = gfc_trans_lock_unlock (code, EXEC_LOCK); gfc_add_expr_to_block (&block, tmp); @@ -1659,7 +1659,7 @@ gfc_trans_critical (gfc_code *code) gfc_add_expr_to_block (&block, tmp); } - else if (flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_SHARED) { tmp = gfc_trans_lock_unlock (code, EXEC_UNLOCK); gfc_add_expr_to_block (&block, tmp); @@ -7213,7 +7213,7 @@ gfc_trans_deallocate (gfc_code *code) tree apstat, pstat, stat, errmsg, errlen, tmp; tree label_finish, label_errmsg; stmtblock_t block; - bool is_native_coarray = false; + bool is_shared_coarray = false; pstat = apstat = stat = errmsg = errlen = tmp = NULL_TREE; label_finish = label_errmsg = NULL_TREE; @@ -7299,7 +7299,7 @@ gfc_trans_deallocate (gfc_code *code) ? GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY : 0); } } - else if (flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_SHARED) { gfc_ref *ref, *last; @@ -7310,16 +7310,16 @@ gfc_trans_deallocate (gfc_code *code) gfc_symbol *sym = expr->symtree->n.sym; int alloc_type = gfc_native_coarray_get_allocation_type (sym); tmp = build_call_expr_loc (input_location, - gfor_fndecl_nca_coarray_free, + gfor_fndecl_cas_coarray_free, 2, gfc_build_addr_expr (pvoid_type_node, se.expr), build_int_cst (integer_type_node, alloc_type)); gfc_add_expr_to_block (&block, tmp); - is_native_coarray = true; + is_shared_coarray = true; } } - if ((expr->rank || is_coarray_array) && !is_native_coarray) + if ((expr->rank || is_coarray_array) && !is_shared_coarray) { gfc_ref *ref; @@ -7408,7 +7408,7 @@ gfc_trans_deallocate (gfc_code *code) gfc_reset_len (&se.pre, al->expr); } } - else if (!is_native_coarray) + else if (!is_shared_coarray) { tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish, false, al->expr, diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index f100d34..e586633 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1346,7 +1346,7 @@ gfc_is_nodesc_array (gfc_symbol * sym) gcc_assert (array_attr->dimension || array_attr->codimension); /* We need a descriptor for native coarrays. */ - if (flag_coarray == GFC_FCOARRAY_NATIVE && sym->as && sym->as->corank) + if (flag_coarray == GFC_FCOARRAY_SHARED && sym->as && sym->as->corank) return 0; /* We only want local arrays. */ @@ -1387,7 +1387,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as, /* For -fcoarray=lib, assumed-shape arrays do not have codimension information stored in the descriptor. */ - if (flag_coarray != GFC_FCOARRAY_NATIVE) + if (flag_coarray != GFC_FCOARRAY_SHARED) { corank = MAX (as->corank, codim); @@ -1608,7 +1608,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, /* We don't use build_array_type because this does not include lang-specific information (i.e. the bounds of the array) when checking for duplicates. */ - if (as->rank || (flag_coarray == GFC_FCOARRAY_NATIVE && as->corank)) + if (as->rank || (flag_coarray == GFC_FCOARRAY_SHARED && as->corank)) type = make_node (ARRAY_TYPE); else type = build_variant_type_copy (etype); @@ -1696,7 +1696,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, GFC_TYPE_ARRAY_UBOUND (type, n) = tmp; } - if (flag_coarray == GFC_FCOARRAY_NATIVE && as->rank == 0 && as->corank != 0) + if (flag_coarray == GFC_FCOARRAY_SHARED && as->rank == 0 && as->corank != 0) GFC_TYPE_ARRAY_OFFSET (type) = NULL_TREE; else if (known_offset) GFC_TYPE_ARRAY_OFFSET (type) = @@ -1725,7 +1725,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, build_qualified_type (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), TYPE_QUAL_RESTRICT); - if (as->rank == 0 && (flag_coarray != GFC_FCOARRAY_NATIVE || as->corank == 0)) + if (as->rank == 0 && (flag_coarray != GFC_FCOARRAY_SHARED || as->corank == 0)) { if (packed != PACKED_STATIC || flag_coarray == GFC_FCOARRAY_LIB) { @@ -1993,7 +1993,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, /* TODO: known offsets for descriptors. */ GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE; - if (flag_coarray != GFC_FCOARRAY_NATIVE && dimen == 0) + if (flag_coarray != GFC_FCOARRAY_SHARED && dimen == 0) { arraytype = build_pointer_type (etype); if (restricted) diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 7d9cd32..6815b17 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -49,16 +49,15 @@ const char gfc_msg_fault[] = N_("Array reference out of bounds"); const char gfc_msg_wrong_return[] = N_("Incorrect function return value"); /* Insert a memory barrier into the code. */ - tree gfc_trans_memory_barrier (void) { tree tmp; - tmp = gfc_build_string_const (strlen ("memory")+1, "memory"), - tmp = build5_loc (input_location, ASM_EXPR, void_type_node, - gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE, - tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE); + tmp = gfc_build_string_const (sizeof ("memory"), "memory"); + tmp = build5_loc (input_location, ASM_EXPR, void_type_node, + gfc_build_string_const (1, ""), NULL_TREE, NULL_TREE, + tree_cons (NULL_TREE, tmp, NULL_TREE), NULL_TREE); ASM_VOLATILE_P (tmp) = 1; return tmp; @@ -420,7 +419,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) tree span = NULL_TREE; if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0 - && flag_coarray != GFC_FCOARRAY_NATIVE) + && flag_coarray != GFC_FCOARRAY_SHARED) { gcc_assert (GFC_TYPE_ARRAY_CORANK (type) > 0); @@ -428,7 +427,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) } /* Scalar library coarray, there is nothing to do. */ - if (TREE_CODE (type) != ARRAY_TYPE && flag_coarray != GFC_FCOARRAY_NATIVE) + if (TREE_CODE (type) != ARRAY_TYPE && flag_coarray != GFC_FCOARRAY_SHARED) { gcc_assert (decl == NULL_TREE); gcc_assert (integer_zerop (offset)); @@ -1376,7 +1375,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, { gcc_assert (GFC_ARRAY_TYPE_P (caf_type) && GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) - != NULL_TREE); + != NULL_TREE); token = GFC_TYPE_ARRAY_CAF_TOKEN (caf_type); } } @@ -1392,7 +1391,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, else caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode; } - else if (flag_coarray == GFC_FCOARRAY_NATIVE) + else if (flag_coarray == GFC_FCOARRAY_SHARED) { orig_desc = pointer; pointer = gfc_conv_descriptor_data_get (pointer); @@ -1448,7 +1447,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, gfc_add_expr_to_block (&non_null, add_when_allocated); gfc_add_finalizer_call (&non_null, expr); if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY - || (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_NATIVE)) + || (flag_coarray != GFC_FCOARRAY_LIB && flag_coarray != GFC_FCOARRAY_SHARED)) { tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_FREE), 1, @@ -1476,10 +1475,10 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, gfc_add_expr_to_block (&non_null, tmp); } } - else if (flag_coarray == GFC_FCOARRAY_NATIVE + else if (flag_coarray == GFC_FCOARRAY_SHARED && coarray_dealloc_mode >= GFC_CAF_COARRAY_ANALYZE) { - tmp = build_call_expr_loc(input_location, gfor_fndecl_nca_coarray_free, + tmp = build_call_expr_loc(input_location, gfor_fndecl_cas_coarray_free, 2, gfc_build_addr_expr (pvoid_type_node, orig_desc), build_int_cst(integer_type_node, GFC_NCA_NORMAL_COARRAY)); gfc_add_expr_to_block (&non_null, tmp); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 974785f..b49ba32 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -895,18 +895,18 @@ extern GTY(()) tree gfor_fndecl_caf_is_present; /* Native coarray library function decls. */ -extern GTY(()) tree gfor_fndecl_nca_this_image; -extern GTY(()) tree gfor_fndecl_nca_num_images; -extern GTY(()) tree gfor_fndecl_nca_coarray_allocate; -extern GTY(()) tree gfor_fndecl_nca_coarray_free; -extern GTY(()) tree gfor_fndecl_nca_sync_images; -extern GTY(()) tree gfor_fndecl_nca_sync_all; -extern GTY(()) tree gfor_fndecl_nca_lock; -extern GTY(()) tree gfor_fndecl_nca_unlock; -extern GTY(()) tree gfor_fndecl_nca_reduce_scalar; -extern GTY(()) tree gfor_fndecl_nca_reduce_array; -extern GTY(()) tree gfor_fndecl_nca_broadcast_scalar; -extern GTY(()) tree gfor_fndecl_nca_broadcast_array; +extern GTY(()) tree gfor_fndecl_cas_this_image; +extern GTY(()) tree gfor_fndecl_cas_num_images; +extern GTY(()) tree gfor_fndecl_cas_coarray_allocate; +extern GTY(()) tree gfor_fndecl_cas_coarray_free; +extern GTY(()) tree gfor_fndecl_cas_sync_images; +extern GTY(()) tree gfor_fndecl_cas_sync_all; +extern GTY(()) tree gfor_fndecl_cas_lock; +extern GTY(()) tree gfor_fndecl_cas_unlock; +extern GTY(()) tree gfor_fndecl_cas_reduce_scalar; +extern GTY(()) tree gfor_fndecl_cas_reduce_array; +extern GTY(()) tree gfor_fndecl_cas_broadcast_scalar; +extern GTY(()) tree gfor_fndecl_cas_broadcast_array; /* Math functions. Many other math functions are handled in trans-intrinsic.c. */ diff --git a/libgfortran/generated/nca_minmax_i1.c b/libgfortran/generated/nca_minmax_i1.c index 3bc9a2b..30a8587 100644 --- a/libgfortran/generated/nca_minmax_i1.c +++ b/libgfortran/generated/nca_minmax_i1.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, +void cas_collsub_max_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_i1); +export_proto(cas_collsub_max_scalar_i1); void -nca_collsub_max_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, +cas_collsub_max_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, } -void nca_collsub_min_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, +void cas_collsub_min_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_i1); +export_proto(cas_collsub_min_scalar_i1); void -nca_collsub_min_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, +cas_collsub_min_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, } -void nca_collsub_sum_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, +void cas_collsub_sum_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_i1); +export_proto(cas_collsub_sum_scalar_i1); void -nca_collsub_sum_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, +cas_collsub_sum_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_i1 (GFC_INTEGER_1 *obj, int *result_image, } -void nca_collsub_max_array_i1 (gfc_array_i1 * restrict array, int *result_image, +void cas_collsub_max_array_i1 (gfc_array_i1 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_i1); +export_proto (cas_collsub_max_array_i1); void -nca_collsub_max_array_i1 (gfc_array_i1 * restrict array, int *result_image, +cas_collsub_max_array_i1 (gfc_array_i1 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_i1 (gfc_array_i1 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_i1 (gfc_array_i1 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_i1 (gfc_array_i1 * restrict array, int *result_image, +void cas_collsub_min_array_i1 (gfc_array_i1 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_i1); +export_proto (cas_collsub_min_array_i1); void -nca_collsub_min_array_i1 (gfc_array_i1 * restrict array, int *result_image, +cas_collsub_min_array_i1 (gfc_array_i1 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_i1 (gfc_array_i1 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_i1 (gfc_array_i1 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_i1 (gfc_array_i1 * restrict array, int *result_image, +void cas_collsub_sum_array_i1 (gfc_array_i1 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_i1); +export_proto (cas_collsub_sum_array_i1); void -nca_collsub_sum_array_i1 (gfc_array_i1 * restrict array, int *result_image, +cas_collsub_sum_array_i1 (gfc_array_i1 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_i1 (gfc_array_i1 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_i16.c b/libgfortran/generated/nca_minmax_i16.c index 8fbb948..f2e4581 100644 --- a/libgfortran/generated/nca_minmax_i16.c +++ b/libgfortran/generated/nca_minmax_i16.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, +void cas_collsub_max_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_i16); +export_proto(cas_collsub_max_scalar_i16); void -nca_collsub_max_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, +cas_collsub_max_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, } -void nca_collsub_min_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, +void cas_collsub_min_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_i16); +export_proto(cas_collsub_min_scalar_i16); void -nca_collsub_min_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, +cas_collsub_min_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, } -void nca_collsub_sum_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, +void cas_collsub_sum_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_i16); +export_proto(cas_collsub_sum_scalar_i16); void -nca_collsub_sum_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, +cas_collsub_sum_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_i16 (GFC_INTEGER_16 *obj, int *result_image, } -void nca_collsub_max_array_i16 (gfc_array_i16 * restrict array, int *result_image, +void cas_collsub_max_array_i16 (gfc_array_i16 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_i16); +export_proto (cas_collsub_max_array_i16); void -nca_collsub_max_array_i16 (gfc_array_i16 * restrict array, int *result_image, +cas_collsub_max_array_i16 (gfc_array_i16 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_i16 (gfc_array_i16 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_i16 (gfc_array_i16 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_i16 (gfc_array_i16 * restrict array, int *result_image, +void cas_collsub_min_array_i16 (gfc_array_i16 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_i16); +export_proto (cas_collsub_min_array_i16); void -nca_collsub_min_array_i16 (gfc_array_i16 * restrict array, int *result_image, +cas_collsub_min_array_i16 (gfc_array_i16 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_i16 (gfc_array_i16 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_i16 (gfc_array_i16 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_i16 (gfc_array_i16 * restrict array, int *result_image, +void cas_collsub_sum_array_i16 (gfc_array_i16 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_i16); +export_proto (cas_collsub_sum_array_i16); void -nca_collsub_sum_array_i16 (gfc_array_i16 * restrict array, int *result_image, +cas_collsub_sum_array_i16 (gfc_array_i16 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_i16 (gfc_array_i16 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_i2.c b/libgfortran/generated/nca_minmax_i2.c index 61908d6..fd8d718 100644 --- a/libgfortran/generated/nca_minmax_i2.c +++ b/libgfortran/generated/nca_minmax_i2.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, +void cas_collsub_max_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_i2); +export_proto(cas_collsub_max_scalar_i2); void -nca_collsub_max_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, +cas_collsub_max_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, } -void nca_collsub_min_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, +void cas_collsub_min_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_i2); +export_proto(cas_collsub_min_scalar_i2); void -nca_collsub_min_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, +cas_collsub_min_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, } -void nca_collsub_sum_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, +void cas_collsub_sum_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_i2); +export_proto(cas_collsub_sum_scalar_i2); void -nca_collsub_sum_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, +cas_collsub_sum_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_i2 (GFC_INTEGER_2 *obj, int *result_image, } -void nca_collsub_max_array_i2 (gfc_array_i2 * restrict array, int *result_image, +void cas_collsub_max_array_i2 (gfc_array_i2 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_i2); +export_proto (cas_collsub_max_array_i2); void -nca_collsub_max_array_i2 (gfc_array_i2 * restrict array, int *result_image, +cas_collsub_max_array_i2 (gfc_array_i2 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_i2 (gfc_array_i2 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_i2 (gfc_array_i2 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_i2 (gfc_array_i2 * restrict array, int *result_image, +void cas_collsub_min_array_i2 (gfc_array_i2 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_i2); +export_proto (cas_collsub_min_array_i2); void -nca_collsub_min_array_i2 (gfc_array_i2 * restrict array, int *result_image, +cas_collsub_min_array_i2 (gfc_array_i2 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_i2 (gfc_array_i2 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_i2 (gfc_array_i2 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_i2 (gfc_array_i2 * restrict array, int *result_image, +void cas_collsub_sum_array_i2 (gfc_array_i2 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_i2); +export_proto (cas_collsub_sum_array_i2); void -nca_collsub_sum_array_i2 (gfc_array_i2 * restrict array, int *result_image, +cas_collsub_sum_array_i2 (gfc_array_i2 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_i2 (gfc_array_i2 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_i4.c b/libgfortran/generated/nca_minmax_i4.c index 5e37586..04972e7 100644 --- a/libgfortran/generated/nca_minmax_i4.c +++ b/libgfortran/generated/nca_minmax_i4.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, +void cas_collsub_max_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_i4); +export_proto(cas_collsub_max_scalar_i4); void -nca_collsub_max_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, +cas_collsub_max_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, } -void nca_collsub_min_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, +void cas_collsub_min_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_i4); +export_proto(cas_collsub_min_scalar_i4); void -nca_collsub_min_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, +cas_collsub_min_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, } -void nca_collsub_sum_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, +void cas_collsub_sum_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_i4); +export_proto(cas_collsub_sum_scalar_i4); void -nca_collsub_sum_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, +cas_collsub_sum_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_i4 (GFC_INTEGER_4 *obj, int *result_image, } -void nca_collsub_max_array_i4 (gfc_array_i4 * restrict array, int *result_image, +void cas_collsub_max_array_i4 (gfc_array_i4 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_i4); +export_proto (cas_collsub_max_array_i4); void -nca_collsub_max_array_i4 (gfc_array_i4 * restrict array, int *result_image, +cas_collsub_max_array_i4 (gfc_array_i4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_i4 (gfc_array_i4 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_i4 (gfc_array_i4 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_i4 (gfc_array_i4 * restrict array, int *result_image, +void cas_collsub_min_array_i4 (gfc_array_i4 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_i4); +export_proto (cas_collsub_min_array_i4); void -nca_collsub_min_array_i4 (gfc_array_i4 * restrict array, int *result_image, +cas_collsub_min_array_i4 (gfc_array_i4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_i4 (gfc_array_i4 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_i4 (gfc_array_i4 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_i4 (gfc_array_i4 * restrict array, int *result_image, +void cas_collsub_sum_array_i4 (gfc_array_i4 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_i4); +export_proto (cas_collsub_sum_array_i4); void -nca_collsub_sum_array_i4 (gfc_array_i4 * restrict array, int *result_image, +cas_collsub_sum_array_i4 (gfc_array_i4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_i4 (gfc_array_i4 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_i8.c b/libgfortran/generated/nca_minmax_i8.c index b3dc861..b4b0864 100644 --- a/libgfortran/generated/nca_minmax_i8.c +++ b/libgfortran/generated/nca_minmax_i8.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, +void cas_collsub_max_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_i8); +export_proto(cas_collsub_max_scalar_i8); void -nca_collsub_max_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, +cas_collsub_max_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, } -void nca_collsub_min_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, +void cas_collsub_min_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_i8); +export_proto(cas_collsub_min_scalar_i8); void -nca_collsub_min_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, +cas_collsub_min_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, } -void nca_collsub_sum_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, +void cas_collsub_sum_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_i8); +export_proto(cas_collsub_sum_scalar_i8); void -nca_collsub_sum_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, +cas_collsub_sum_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_i8 (GFC_INTEGER_8 *obj, int *result_image, } -void nca_collsub_max_array_i8 (gfc_array_i8 * restrict array, int *result_image, +void cas_collsub_max_array_i8 (gfc_array_i8 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_i8); +export_proto (cas_collsub_max_array_i8); void -nca_collsub_max_array_i8 (gfc_array_i8 * restrict array, int *result_image, +cas_collsub_max_array_i8 (gfc_array_i8 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_i8 (gfc_array_i8 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_i8 (gfc_array_i8 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_i8 (gfc_array_i8 * restrict array, int *result_image, +void cas_collsub_min_array_i8 (gfc_array_i8 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_i8); +export_proto (cas_collsub_min_array_i8); void -nca_collsub_min_array_i8 (gfc_array_i8 * restrict array, int *result_image, +cas_collsub_min_array_i8 (gfc_array_i8 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_i8 (gfc_array_i8 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_i8 (gfc_array_i8 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_i8 (gfc_array_i8 * restrict array, int *result_image, +void cas_collsub_sum_array_i8 (gfc_array_i8 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_i8); +export_proto (cas_collsub_sum_array_i8); void -nca_collsub_sum_array_i8 (gfc_array_i8 * restrict array, int *result_image, +cas_collsub_sum_array_i8 (gfc_array_i8 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_i8 (gfc_array_i8 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_r10.c b/libgfortran/generated/nca_minmax_r10.c index 10f7324..6711157 100644 --- a/libgfortran/generated/nca_minmax_r10.c +++ b/libgfortran/generated/nca_minmax_r10.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_r10 (GFC_REAL_10 *obj, int *result_image, +void cas_collsub_max_scalar_r10 (GFC_REAL_10 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_r10); +export_proto(cas_collsub_max_scalar_r10); void -nca_collsub_max_scalar_r10 (GFC_REAL_10 *obj, int *result_image, +cas_collsub_max_scalar_r10 (GFC_REAL_10 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_r10 (GFC_REAL_10 *obj, int *result_image, } -void nca_collsub_min_scalar_r10 (GFC_REAL_10 *obj, int *result_image, +void cas_collsub_min_scalar_r10 (GFC_REAL_10 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_r10); +export_proto(cas_collsub_min_scalar_r10); void -nca_collsub_min_scalar_r10 (GFC_REAL_10 *obj, int *result_image, +cas_collsub_min_scalar_r10 (GFC_REAL_10 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_r10 (GFC_REAL_10 *obj, int *result_image, } -void nca_collsub_sum_scalar_r10 (GFC_REAL_10 *obj, int *result_image, +void cas_collsub_sum_scalar_r10 (GFC_REAL_10 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_r10); +export_proto(cas_collsub_sum_scalar_r10); void -nca_collsub_sum_scalar_r10 (GFC_REAL_10 *obj, int *result_image, +cas_collsub_sum_scalar_r10 (GFC_REAL_10 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_r10 (GFC_REAL_10 *obj, int *result_image, } -void nca_collsub_max_array_r10 (gfc_array_r10 * restrict array, int *result_image, +void cas_collsub_max_array_r10 (gfc_array_r10 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_r10); +export_proto (cas_collsub_max_array_r10); void -nca_collsub_max_array_r10 (gfc_array_r10 * restrict array, int *result_image, +cas_collsub_max_array_r10 (gfc_array_r10 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_r10 (gfc_array_r10 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_r10 (gfc_array_r10 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_r10 (gfc_array_r10 * restrict array, int *result_image, +void cas_collsub_min_array_r10 (gfc_array_r10 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_r10); +export_proto (cas_collsub_min_array_r10); void -nca_collsub_min_array_r10 (gfc_array_r10 * restrict array, int *result_image, +cas_collsub_min_array_r10 (gfc_array_r10 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_r10 (gfc_array_r10 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_r10 (gfc_array_r10 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_r10 (gfc_array_r10 * restrict array, int *result_image, +void cas_collsub_sum_array_r10 (gfc_array_r10 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_r10); +export_proto (cas_collsub_sum_array_r10); void -nca_collsub_sum_array_r10 (gfc_array_r10 * restrict array, int *result_image, +cas_collsub_sum_array_r10 (gfc_array_r10 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_r10 (gfc_array_r10 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_r16.c b/libgfortran/generated/nca_minmax_r16.c index a0a0a51..959aec7 100644 --- a/libgfortran/generated/nca_minmax_r16.c +++ b/libgfortran/generated/nca_minmax_r16.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_r16 (GFC_REAL_16 *obj, int *result_image, +void cas_collsub_max_scalar_r16 (GFC_REAL_16 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_r16); +export_proto(cas_collsub_max_scalar_r16); void -nca_collsub_max_scalar_r16 (GFC_REAL_16 *obj, int *result_image, +cas_collsub_max_scalar_r16 (GFC_REAL_16 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_r16 (GFC_REAL_16 *obj, int *result_image, } -void nca_collsub_min_scalar_r16 (GFC_REAL_16 *obj, int *result_image, +void cas_collsub_min_scalar_r16 (GFC_REAL_16 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_r16); +export_proto(cas_collsub_min_scalar_r16); void -nca_collsub_min_scalar_r16 (GFC_REAL_16 *obj, int *result_image, +cas_collsub_min_scalar_r16 (GFC_REAL_16 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_r16 (GFC_REAL_16 *obj, int *result_image, } -void nca_collsub_sum_scalar_r16 (GFC_REAL_16 *obj, int *result_image, +void cas_collsub_sum_scalar_r16 (GFC_REAL_16 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_r16); +export_proto(cas_collsub_sum_scalar_r16); void -nca_collsub_sum_scalar_r16 (GFC_REAL_16 *obj, int *result_image, +cas_collsub_sum_scalar_r16 (GFC_REAL_16 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_r16 (GFC_REAL_16 *obj, int *result_image, } -void nca_collsub_max_array_r16 (gfc_array_r16 * restrict array, int *result_image, +void cas_collsub_max_array_r16 (gfc_array_r16 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_r16); +export_proto (cas_collsub_max_array_r16); void -nca_collsub_max_array_r16 (gfc_array_r16 * restrict array, int *result_image, +cas_collsub_max_array_r16 (gfc_array_r16 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_r16 (gfc_array_r16 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_r16 (gfc_array_r16 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_r16 (gfc_array_r16 * restrict array, int *result_image, +void cas_collsub_min_array_r16 (gfc_array_r16 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_r16); +export_proto (cas_collsub_min_array_r16); void -nca_collsub_min_array_r16 (gfc_array_r16 * restrict array, int *result_image, +cas_collsub_min_array_r16 (gfc_array_r16 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_r16 (gfc_array_r16 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_r16 (gfc_array_r16 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_r16 (gfc_array_r16 * restrict array, int *result_image, +void cas_collsub_sum_array_r16 (gfc_array_r16 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_r16); +export_proto (cas_collsub_sum_array_r16); void -nca_collsub_sum_array_r16 (gfc_array_r16 * restrict array, int *result_image, +cas_collsub_sum_array_r16 (gfc_array_r16 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_r16 (gfc_array_r16 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_r4.c b/libgfortran/generated/nca_minmax_r4.c index 0eb3f1b..02dd3b6 100644 --- a/libgfortran/generated/nca_minmax_r4.c +++ b/libgfortran/generated/nca_minmax_r4.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_r4 (GFC_REAL_4 *obj, int *result_image, +void cas_collsub_max_scalar_r4 (GFC_REAL_4 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_r4); +export_proto(cas_collsub_max_scalar_r4); void -nca_collsub_max_scalar_r4 (GFC_REAL_4 *obj, int *result_image, +cas_collsub_max_scalar_r4 (GFC_REAL_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_r4 (GFC_REAL_4 *obj, int *result_image, } -void nca_collsub_min_scalar_r4 (GFC_REAL_4 *obj, int *result_image, +void cas_collsub_min_scalar_r4 (GFC_REAL_4 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_r4); +export_proto(cas_collsub_min_scalar_r4); void -nca_collsub_min_scalar_r4 (GFC_REAL_4 *obj, int *result_image, +cas_collsub_min_scalar_r4 (GFC_REAL_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_r4 (GFC_REAL_4 *obj, int *result_image, } -void nca_collsub_sum_scalar_r4 (GFC_REAL_4 *obj, int *result_image, +void cas_collsub_sum_scalar_r4 (GFC_REAL_4 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_r4); +export_proto(cas_collsub_sum_scalar_r4); void -nca_collsub_sum_scalar_r4 (GFC_REAL_4 *obj, int *result_image, +cas_collsub_sum_scalar_r4 (GFC_REAL_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_r4 (GFC_REAL_4 *obj, int *result_image, } -void nca_collsub_max_array_r4 (gfc_array_r4 * restrict array, int *result_image, +void cas_collsub_max_array_r4 (gfc_array_r4 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_r4); +export_proto (cas_collsub_max_array_r4); void -nca_collsub_max_array_r4 (gfc_array_r4 * restrict array, int *result_image, +cas_collsub_max_array_r4 (gfc_array_r4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_r4 (gfc_array_r4 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_r4 (gfc_array_r4 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_r4 (gfc_array_r4 * restrict array, int *result_image, +void cas_collsub_min_array_r4 (gfc_array_r4 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_r4); +export_proto (cas_collsub_min_array_r4); void -nca_collsub_min_array_r4 (gfc_array_r4 * restrict array, int *result_image, +cas_collsub_min_array_r4 (gfc_array_r4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_r4 (gfc_array_r4 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_r4 (gfc_array_r4 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_r4 (gfc_array_r4 * restrict array, int *result_image, +void cas_collsub_sum_array_r4 (gfc_array_r4 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_r4); +export_proto (cas_collsub_sum_array_r4); void -nca_collsub_sum_array_r4 (gfc_array_r4 * restrict array, int *result_image, +cas_collsub_sum_array_r4 (gfc_array_r4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_r4 (gfc_array_r4 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_r8.c b/libgfortran/generated/nca_minmax_r8.c index 3b3e962..6af88cb 100644 --- a/libgfortran/generated/nca_minmax_r8.c +++ b/libgfortran/generated/nca_minmax_r8.c @@ -30,14 +30,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" -void nca_collsub_max_scalar_r8 (GFC_REAL_8 *obj, int *result_image, +void cas_collsub_max_scalar_r8 (GFC_REAL_8 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_r8); +export_proto(cas_collsub_max_scalar_r8); void -nca_collsub_max_scalar_r8 (GFC_REAL_8 *obj, int *result_image, +cas_collsub_max_scalar_r8 (GFC_REAL_8 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -77,12 +76,12 @@ nca_collsub_max_scalar_r8 (GFC_REAL_8 *obj, int *result_image, } -void nca_collsub_min_scalar_r8 (GFC_REAL_8 *obj, int *result_image, +void cas_collsub_min_scalar_r8 (GFC_REAL_8 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_r8); +export_proto(cas_collsub_min_scalar_r8); void -nca_collsub_min_scalar_r8 (GFC_REAL_8 *obj, int *result_image, +cas_collsub_min_scalar_r8 (GFC_REAL_8 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -122,12 +121,12 @@ nca_collsub_min_scalar_r8 (GFC_REAL_8 *obj, int *result_image, } -void nca_collsub_sum_scalar_r8 (GFC_REAL_8 *obj, int *result_image, +void cas_collsub_sum_scalar_r8 (GFC_REAL_8 *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_sum_scalar_r8); +export_proto(cas_collsub_sum_scalar_r8); void -nca_collsub_sum_scalar_r8 (GFC_REAL_8 *obj, int *result_image, +cas_collsub_sum_scalar_r8 (GFC_REAL_8 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -166,12 +165,12 @@ nca_collsub_sum_scalar_r8 (GFC_REAL_8 *obj, int *result_image, } -void nca_collsub_max_array_r8 (gfc_array_r8 * restrict array, int *result_image, +void cas_collsub_max_array_r8 (gfc_array_r8 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_max_array_r8); +export_proto (cas_collsub_max_array_r8); void -nca_collsub_max_array_r8 (gfc_array_r8 * restrict array, int *result_image, +cas_collsub_max_array_r8 (gfc_array_r8 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -296,8 +295,7 @@ nca_collsub_max_array_r8 (gfc_array_r8 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -327,12 +325,12 @@ nca_collsub_max_array_r8 (gfc_array_r8 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_r8 (gfc_array_r8 * restrict array, int *result_image, +void cas_collsub_min_array_r8 (gfc_array_r8 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_min_array_r8); +export_proto (cas_collsub_min_array_r8); void -nca_collsub_min_array_r8 (gfc_array_r8 * restrict array, int *result_image, +cas_collsub_min_array_r8 (gfc_array_r8 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -457,8 +455,7 @@ nca_collsub_min_array_r8 (gfc_array_r8 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -488,12 +485,12 @@ nca_collsub_min_array_r8 (gfc_array_r8 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_sum_array_r8 (gfc_array_r8 * restrict array, int *result_image, +void cas_collsub_sum_array_r8 (gfc_array_r8 * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_sum_array_r8); +export_proto (cas_collsub_sum_array_r8); void -nca_collsub_sum_array_r8 (gfc_array_r8 * restrict array, int *result_image, +cas_collsub_sum_array_r8 (gfc_array_r8 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -617,8 +614,7 @@ nca_collsub_sum_array_r8 (gfc_array_r8 * restrict array, int *result_image, char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_s1.c b/libgfortran/generated/nca_minmax_s1.c index b081452..493de0b 100644 --- a/libgfortran/generated/nca_minmax_s1.c +++ b/libgfortran/generated/nca_minmax_s1.c @@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" #if 1 == 4 @@ -53,12 +52,12 @@ memcmp4 (const void *a, const void *b, size_t len) } #endif -void nca_collsub_max_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, +void cas_collsub_max_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_s1); +export_proto(cas_collsub_max_scalar_s1); void -nca_collsub_max_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, +cas_collsub_max_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, @@ -92,22 +91,28 @@ nca_collsub_max_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, } collsub_sync (ci); } + /* All images have to execute the same number of collsub_sync, otherwise + some images will hang. Here, we execute the missing ones for images + that are not needed anymore in the main loop. */ for ( ; (local->num_images >> cbit) != 0; cbit++) collsub_sync (ci); if (!result_image || (*result_image - 1) == this_image.image_num) memcpy (obj, buffer, type_size); + /* We need one barrier (it could be either before or after the collsub) that + prevents one image from starting a new collsub before the old one has + finished. */ finish_collective_subroutine (ci); } -void nca_collsub_min_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, +void cas_collsub_min_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_s1); +export_proto(cas_collsub_min_scalar_s1); void -nca_collsub_min_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, +cas_collsub_min_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, @@ -141,30 +146,36 @@ nca_collsub_min_scalar_s1 (GFC_UINTEGER_1 *obj, int *result_image, } collsub_sync (ci); } + /* All images have to execute the same number of collsub_sync, otherwise + some images will hang. Here, we execute the missing ones for images + that are not needed anymore in the main loop. */ for ( ; (local->num_images >> cbit) != 0; cbit++) collsub_sync (ci); if (!result_image || (*result_image - 1) == this_image.image_num) memcpy (obj, buffer, type_size); + /* We need one barrier (it could be either before or after the collsub) that + prevents one image from starting a new collsub before the old one has + finished. */ finish_collective_subroutine (ci); } -void nca_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, +void cas_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto (nca_collsub_max_array_s1); +export_proto (cas_collsub_max_array_s1); void -nca_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, +cas_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, index_type errmsg_len __attribute__ ((unused))) { index_type count[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; /* stride is byte-based here. */ + index_type stride[GFC_MAX_DIMENSIONS]; /* Store byte-based strides here. */ index_type extent[GFC_MAX_DIMENSIONS]; char *this_shared_ptr; /* Points to the shared memory allocated to this image. */ char *buffer; @@ -182,7 +193,6 @@ nca_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, type_size = char_len * sizeof (GFC_UINTEGER_1); dim = GFC_DESCRIPTOR_RANK (array); num_elems = 1; - ssize = type_size; packed = true; span = array->span != 0 ? array->span : type_size; for (index_type n = 0; n < dim; n++) @@ -288,8 +298,7 @@ nca_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, char *restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof (index_type) * dim); while (dest) { @@ -320,20 +329,20 @@ nca_collsub_max_array_s1 (gfc_array_s1 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_s1 (gfc_array_s1 * restrict array, int *result_image, +void cas_collsub_min_array_s1 (gfc_array_s1 * restrict array, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto (nca_collsub_min_array_s1); +export_proto (cas_collsub_min_array_s1); void -nca_collsub_min_array_s1 (gfc_array_s1 * restrict array, int *result_image, +cas_collsub_min_array_s1 (gfc_array_s1 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, index_type errmsg_len __attribute__ ((unused))) { index_type count[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; /* stride is byte-based here. */ + index_type stride[GFC_MAX_DIMENSIONS]; /* Store byte-based strides here. */ index_type extent[GFC_MAX_DIMENSIONS]; char *this_shared_ptr; /* Points to the shared memory allocated to this image. */ char *buffer; @@ -351,7 +360,6 @@ nca_collsub_min_array_s1 (gfc_array_s1 * restrict array, int *result_image, type_size = char_len * sizeof (GFC_UINTEGER_1); dim = GFC_DESCRIPTOR_RANK (array); num_elems = 1; - ssize = type_size; packed = true; span = array->span != 0 ? array->span : type_size; for (index_type n = 0; n < dim; n++) @@ -457,8 +465,7 @@ nca_collsub_min_array_s1 (gfc_array_s1 * restrict array, int *result_image, char *restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof (index_type) * dim); while (dest) { diff --git a/libgfortran/generated/nca_minmax_s4.c b/libgfortran/generated/nca_minmax_s4.c index b202fda..9f74da2 100644 --- a/libgfortran/generated/nca_minmax_s4.c +++ b/libgfortran/generated/nca_minmax_s4.c @@ -31,7 +31,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" #if 4 == 4 @@ -53,12 +52,12 @@ memcmp4 (const void *a, const void *b, size_t len) } #endif -void nca_collsub_max_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, +void cas_collsub_max_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto(nca_collsub_max_scalar_s4); +export_proto(cas_collsub_max_scalar_s4); void -nca_collsub_max_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, +cas_collsub_max_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, @@ -92,22 +91,28 @@ nca_collsub_max_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, } collsub_sync (ci); } + /* All images have to execute the same number of collsub_sync, otherwise + some images will hang. Here, we execute the missing ones for images + that are not needed anymore in the main loop. */ for ( ; (local->num_images >> cbit) != 0; cbit++) collsub_sync (ci); if (!result_image || (*result_image - 1) == this_image.image_num) memcpy (obj, buffer, type_size); + /* We need one barrier (it could be either before or after the collsub) that + prevents one image from starting a new collsub before the old one has + finished. */ finish_collective_subroutine (ci); } -void nca_collsub_min_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, +void cas_collsub_min_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto(nca_collsub_min_scalar_s4); +export_proto(cas_collsub_min_scalar_s4); void -nca_collsub_min_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, +cas_collsub_min_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, @@ -141,30 +146,36 @@ nca_collsub_min_scalar_s4 (GFC_UINTEGER_4 *obj, int *result_image, } collsub_sync (ci); } + /* All images have to execute the same number of collsub_sync, otherwise + some images will hang. Here, we execute the missing ones for images + that are not needed anymore in the main loop. */ for ( ; (local->num_images >> cbit) != 0; cbit++) collsub_sync (ci); if (!result_image || (*result_image - 1) == this_image.image_num) memcpy (obj, buffer, type_size); + /* We need one barrier (it could be either before or after the collsub) that + prevents one image from starting a new collsub before the old one has + finished. */ finish_collective_subroutine (ci); } -void nca_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, +void cas_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto (nca_collsub_max_array_s4); +export_proto (cas_collsub_max_array_s4); void -nca_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, +cas_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, index_type errmsg_len __attribute__ ((unused))) { index_type count[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; /* stride is byte-based here. */ + index_type stride[GFC_MAX_DIMENSIONS]; /* Store byte-based strides here. */ index_type extent[GFC_MAX_DIMENSIONS]; char *this_shared_ptr; /* Points to the shared memory allocated to this image. */ char *buffer; @@ -182,7 +193,6 @@ nca_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, type_size = char_len * sizeof (GFC_UINTEGER_4); dim = GFC_DESCRIPTOR_RANK (array); num_elems = 1; - ssize = type_size; packed = true; span = array->span != 0 ? array->span : type_size; for (index_type n = 0; n < dim; n++) @@ -288,8 +298,7 @@ nca_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, char *restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof (index_type) * dim); while (dest) { @@ -320,20 +329,20 @@ nca_collsub_max_array_s4 (gfc_array_s4 * restrict array, int *result_image, } finish_collective_subroutine (ci); } -void nca_collsub_min_array_s4 (gfc_array_s4 * restrict array, int *result_image, +void cas_collsub_min_array_s4 (gfc_array_s4 * restrict array, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto (nca_collsub_min_array_s4); +export_proto (cas_collsub_min_array_s4); void -nca_collsub_min_array_s4 (gfc_array_s4 * restrict array, int *result_image, +cas_collsub_min_array_s4 (gfc_array_s4 * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, index_type errmsg_len __attribute__ ((unused))) { index_type count[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; /* stride is byte-based here. */ + index_type stride[GFC_MAX_DIMENSIONS]; /* Store byte-based strides here. */ index_type extent[GFC_MAX_DIMENSIONS]; char *this_shared_ptr; /* Points to the shared memory allocated to this image. */ char *buffer; @@ -351,7 +360,6 @@ nca_collsub_min_array_s4 (gfc_array_s4 * restrict array, int *result_image, type_size = char_len * sizeof (GFC_UINTEGER_4); dim = GFC_DESCRIPTOR_RANK (array); num_elems = 1; - ssize = type_size; packed = true; span = array->span != 0 ? array->span : type_size; for (index_type n = 0; n < dim; n++) @@ -457,8 +465,7 @@ nca_collsub_min_array_s4 (gfc_array_s4 * restrict array, int *result_image, char *restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof (index_type) * dim); while (dest) { diff --git a/libgfortran/m4/nca-minmax-s.m4 b/libgfortran/m4/nca-minmax-s.m4 index 2d8891f..af5dd5d 100644 --- a/libgfortran/m4/nca-minmax-s.m4 +++ b/libgfortran/m4/nca-minmax-s.m4 @@ -30,12 +30,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see include(iparm.m4)dnl define(`compare_fcn',`ifelse(rtype_kind,1,memcmp,memcmp4)')dnl -define(SCALAR_FUNCTION,`void nca_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, +define(SCALAR_FUNCTION,`void cas_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto(nca_collsub_'$1`_scalar_'rtype_code`); +export_proto(cas_collsub_'$1`_scalar_'rtype_code`); void -nca_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, +cas_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, @@ -69,32 +69,38 @@ nca_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, } collsub_sync (ci); } + /* All images have to execute the same number of collsub_sync, otherwise + some images will hang. Here, we execute the missing ones for images + that are not needed anymore in the main loop. */ for ( ; (local->num_images >> cbit) != 0; cbit++) collsub_sync (ci); if (!result_image || (*result_image - 1) == this_image.image_num) memcpy (obj, buffer, type_size); + /* We need one barrier (it could be either before or after the collsub) that + prevents one image from starting a new collsub before the old one has + finished. */ finish_collective_subroutine (ci); } ')dnl define(ARRAY_FUNCTION,dnl -`void nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, +`void cas_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, int *stat, char *errmsg, index_type char_len, index_type errmsg_len); -export_proto (nca_collsub_'$1`_array_'rtype_code`); +export_proto (cas_collsub_'$1`_array_'rtype_code`); void -nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, +cas_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type char_len, index_type errmsg_len __attribute__ ((unused))) { index_type count[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; /* stride is byte-based here. */ + index_type stride[GFC_MAX_DIMENSIONS]; /* Store byte-based strides here. */ index_type extent[GFC_MAX_DIMENSIONS]; char *this_shared_ptr; /* Points to the shared memory allocated to this image. */ char *buffer; @@ -112,7 +118,6 @@ nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image type_size = char_len * sizeof ('rtype_name`); dim = GFC_DESCRIPTOR_RANK (array); num_elems = 1; - ssize = type_size; packed = true; span = array->span != 0 ? array->span : type_size; for (index_type n = 0; n < dim; n++) @@ -218,8 +223,7 @@ nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image char *restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof (index_type) * dim); while (dest) { @@ -258,7 +262,6 @@ nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" #if 'rtype_kind` == 4 diff --git a/libgfortran/m4/nca_minmax.m4 b/libgfortran/m4/nca_minmax.m4 index 76070c1..9e107fc 100644 --- a/libgfortran/m4/nca_minmax.m4 +++ b/libgfortran/m4/nca_minmax.m4 @@ -29,12 +29,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see <http://www.gnu.org/licenses/>. */' include(iparm.m4)dnl -define(SCALAR_FUNCTION,`void nca_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, +define(SCALAR_FUNCTION,`void cas_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto(nca_collsub_'$1`_scalar_'rtype_code`); +export_proto(cas_collsub_'$1`_scalar_'rtype_code`); void -nca_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, +cas_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -75,12 +75,12 @@ nca_collsub_'$1`_scalar_'rtype_code` ('rtype_name` *obj, int *result_image, ')dnl define(ARRAY_FUNCTION,dnl -`void nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, +`void cas_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, int *stat, char *errmsg, index_type errmsg_len); -export_proto (nca_collsub_'$1`_array_'rtype_code`); +export_proto (cas_collsub_'$1`_array_'rtype_code`); void -nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, +cas_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image, int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), index_type errmsg_len __attribute__ ((unused))) @@ -204,8 +204,7 @@ nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image char * restrict dest = (char *) array->base_addr; index_type stride0 = stride[0]; - for (index_type n = 0; n < dim; n++) - count[n] = 0; + memset (count, 0, sizeof(index_type) * dim); while (dest) { @@ -242,7 +241,6 @@ nca_collsub_'$1`_array_'rtype_code` ('rtype` * restrict array, int *result_image #include <string.h> #include "../nca/libcoarraynative.h" #include "../nca/collective_subroutine.h" -#include "../nca/collective_inline.h" SCALAR_FUNCTION(`max',`if (*b > *a) *a = *b;')dnl diff --git a/libgfortran/nca/.tags b/libgfortran/nca/.tags deleted file mode 100644 index 07d260d..0000000 --- a/libgfortran/nca/.tags +++ /dev/null @@ -1,275 +0,0 @@ -!_TAG_FILE_FORMAT 2 /extended format; --format=1 will not append ;" to lines/ -!_TAG_FILE_SORTED 1 /0=unsorted, 1=sorted, 2=foldcase/ -!_TAG_PROGRAM_AUTHOR Darren Hiebert /dhiebert@users.sourceforge.net/ -!_TAG_PROGRAM_NAME Exuberant Ctags // -!_TAG_PROGRAM_URL http://ctags.sourceforge.net /official site/ -!_TAG_PROGRAM_VERSION 5.9~svn20110310 // -ALIGN_TO serialize.c 47;" d file: -ALLOC_H alloc.h 26;" d -COARRAY_LOCK_HDR lock.h 27;" d -COARRAY_NATIVE_HDR libcoarraynative.h 30;" d -COLLECTIVE_SUBROUTINE_HDR collective_subroutine.h 3;" d -CRITICAL_LOOKAHEAD hashmap.c 30;" d file: -DEBUG_PRINTF libcoarraynative.h 45;" d -DEBUG_PRINTF libcoarraynative.h 47;" d -FILL_VALUE serialize.c 57;" d file: -GFC_NCA_EVENT_COARRAY wrapper.c /^ GFC_NCA_EVENT_COARRAY,$/;" e enum:gfc_coarray_allocation_type file: -GFC_NCA_LOCK_COARRAY wrapper.c /^ GFC_NCA_LOCK_COARRAY,$/;" e enum:gfc_coarray_allocation_type file: -GFC_NCA_NORMAL_COARRAY wrapper.c /^ GFC_NCA_NORMAL_COARRAY = 3,$/;" e enum:gfc_coarray_allocation_type file: -GFORTRAN_ENV_NUM_IMAGES coarraynative.c 37;" d file: -HASHMAP_H hashmap.h 69;" d -IMAGE_FAILED libcoarraynative.h /^ IMAGE_FAILED$/;" e enum:__anon7 -IMAGE_FAILED master.c /^ IMAGE_FAILED$/;" e enum:__anon5 file: -IMAGE_OK libcoarraynative.h /^ IMAGE_OK,$/;" e enum:__anon7 -IMAGE_OK master.c /^ IMAGE_OK,$/;" e enum:__anon5 file: -IMAGE_UNKNOWN libcoarraynative.h /^ IMAGE_UNKNOWN = 0,$/;" e enum:__anon7 -IMAGE_UNKNOWN master.c /^ IMAGE_UNKNOWN = 0,$/;" e enum:__anon5 file: -INDENT hashmap.c 403;" d file: -INDENT hashmap.c 414;" d file: -INDENT hashmap.c 415;" d file: -INDENT hashmap.c 429;" d file: -INDENT hashmap.c 430;" d file: -INITIAL_BITNUM hashmap.c 28;" d file: -INITIAL_SIZE hashmap.c 29;" d file: -IPSYNC_HDR sync.h 26;" d -ITER malloc_test.c 13;" d file: -MAX_ALIGN allocator.c 50;" d file: -MAX_NUM malloc_test.c 10;" d file: -MEMOBJ_NAME util.c 11;" d file: -MIN_NUM malloc_test.c 11;" d file: -NUM_BITS malloc_test.c 8;" d file: -NUM_SIZES malloc_test.c 9;" d file: -PE hashmap.c 402;" d file: -PTR_BITS util.h 32;" d -SHARED_ALLOCATOR_HDR allocator.h 2;" d -SHARED_MEMORY_H shared_memory.h 77;" d -SHARED_MEMORY_RAW_ALLOC shared_memory.h 50;" d -SHARED_MEMORY_RAW_ALLOC_PTR shared_memory.h 53;" d -SHMPTR_AS shared_memory.h 46;" d -SHMPTR_DEREF shared_memory.h 44;" d -SHMPTR_EQUALS shared_memory.h 48;" d -SHMPTR_IS_NULL shared_memory.h 42;" d -SHMPTR_NULL shared_memory.h 41;" d -SHMPTR_SET shared_memory.h 47;" d -SZ malloc_test.c 12;" d file: -UTIL_HDR util.h 26;" d -a hashmap.h /^ allocator *a;$/;" m struct:hashmap -a sync.h /^ allocator *a;$/;" m struct:__anon3 -ai libcoarraynative.h /^ alloc_iface ai;$/;" m struct:__anon11 -alignto util.c /^alignto(size_t size, size_t align) {$/;" f -alloc alloc.h /^ allocator alloc;$/;" m struct:alloc_iface -alloc_iface alloc.h /^typedef struct alloc_iface$/;" s -alloc_iface alloc.h /^} alloc_iface;$/;" t typeref:struct:alloc_iface -alloc_iface_init alloc.c /^alloc_iface_init (alloc_iface *iface, shared_memory *mem)$/;" f -alloc_iface_init alloc.h /^internal_proto (alloc_iface_init);$/;" v -alloc_iface_shared alloc.h /^typedef struct alloc_iface_shared$/;" s -alloc_iface_shared alloc.h /^} alloc_iface_shared;$/;" t typeref:struct:alloc_iface_shared -allocator allocator.h /^} allocator;$/;" t typeref:struct:__anon17 -allocator_init allocator.c /^allocator_init (allocator *a, allocator_shared *s, shared_memory *sm)$/;" f -allocator_s alloc.h /^ allocator_shared allocator_s;$/;" m struct:alloc_iface_shared -allocator_shared allocator.h /^} allocator_shared;$/;" t typeref:struct:__anon16 -allocs shared_memory.c /^ } allocs[];$/;" m struct:shared_memory_act typeref:struct:shared_memory_act::local_alloc file: -arr lock.h /^ pthread_mutex_t arr[];$/;" m struct:__anon12 -as alloc.h /^ alloc_iface_shared *as;$/;" m struct:alloc_iface -barrier collective_subroutine.h /^ pthread_barrier_t barrier;$/;" m struct:collsub_iface_shared -barrier libcoarraynative.h /^ pthread_barrier_t barrier;$/;" m struct:__anon6 -base shared_memory.c /^ void *base;$/;" m struct:shared_memory_act::local_alloc file: -bitnum hashmap.h /^ int bitnum;$/;" m struct:__anon14 -bucket allocator.c /^} bucket;$/;" t typeref:struct:__anon1 file: -ci libcoarraynative.h /^ collsub_iface ci;$/;" m struct:__anon11 -cis sync.h /^ sync_iface_shared *cis;$/;" m struct:__anon3 -collsub_broadcast collective_subroutine.h /^internal_proto (collsub_broadcast);$/;" v -collsub_buf collective_subroutine.c /^void *collsub_buf = NULL;$/;" v -collsub_buf collective_subroutine.h /^ shared_mem_ptr collsub_buf;$/;" m struct:collsub_iface_shared -collsub_buf collective_subroutine.h /^ void *collsub_buf; \/* Cached pointer to shared collsub_buf. *\/$/;" m struct:collsub_iface -collsub_buf collective_subroutine.h /^internal_proto (collsub_buf);$/;" v -collsub_iface collective_subroutine.h /^typedef struct collsub_iface$/;" s -collsub_iface collective_subroutine.h /^} collsub_iface;$/;" t typeref:struct:collsub_iface -collsub_iface_shared collective_subroutine.h /^typedef struct collsub_iface_shared $/;" s -collsub_iface_shared collective_subroutine.h /^} collsub_iface_shared;$/;" t typeref:struct:collsub_iface_shared -collsub_reduce collective_subroutine.c /^collsub_reduce (void *obj, size_t nobjs, int *result_image, size_t size, $/;" f -collsub_reduce collective_subroutine.h /^internal_proto (collsub_reduce);$/;" v -collsub_sync collective_subroutine.c /^collsub_sync (void) {$/;" f -collsub_sync collective_subroutine.h /^internal_proto (collsub_sync);$/;" v -copy_from collective_inline.h /^copy_from (int image) $/;" f -copy_in collective_inline.h /^copy_in (void *obj) {$/;" f -copy_out collective_inline.h /^copy_out (void *obj, int image)$/;" f -copy_to collective_inline.h /^copy_to (void *obj, int image)$/;" f -curr_size collective_subroutine.c /^size_t curr_size = 0;$/;" v -curr_size collective_subroutine.h /^ size_t curr_size;$/;" m struct:collsub_iface_shared -curr_size collective_subroutine.h /^internal_proto (curr_size);$/;" v -data hashmap.h /^ shared_mem_ptr data;$/;" m struct:__anon14 -deserialize_memory serialize.c /^export_proto (deserialize_memory);$/;" v -div_ru wrapper.c /^div_ru (int divident, int divisor)$/;" f file: -dump_hm hashmap.c /^dump_hm(hashmap *hm) {$/;" f -enlarge_hashmap_mem hashmap.c /^enlarge_hashmap_mem (hashmap *hm, hashmap_entry **data, bool f)$/;" f file: -ensure_initialization coarraynative.c /^ensure_initialization(void) {$/;" f -fd shared_memory.c /^ int fd;$/;" m struct:__anon18 file: -finish_collective_subroutine collective_inline.h /^finish_collective_subroutine (void) $/;" f -free_bucket_head allocator.h /^ shared_mem_ptr free_bucket_head[PTR_BITS];$/;" m struct:__anon16 -free_memory_with_id alloc.c /^free_memory_with_id (alloc_iface* iface, memid id)$/;" f -free_memory_with_id alloc.h /^internal_proto (free_memory_with_id);$/;" v -gen_mask hashmap.c /^gen_mask (hashmap *hm)$/;" f file: -get_allocator alloc.c /^get_allocator (alloc_iface * iface)$/;" f -get_allocator alloc.h /^internal_proto (get_allocator);$/;" v -get_data hashmap.c /^get_data(hashmap *hm)$/;" f file: -get_environ_image_num coarraynative.c /^get_environ_image_num (void)$/;" f file: -get_expected_offset hashmap.c /^get_expected_offset (hashmap *hm, memid id)$/;" f file: -get_locked_table sync.c /^get_locked_table(sync_iface *si) { \/\/ The initialization of the table has to $/;" f file: -get_master coarraynative.c /^get_master (void) {$/;" f file: -get_memory_by_id alloc.c /^get_memory_by_id (alloc_iface *iface, size_t size, memid id)$/;" f -get_memory_by_id alloc.h /^internal_proto (get_memory_by_id);$/;" v -get_obj_ptr collective_inline.h /^get_obj_ptr (int image) $/;" f -get_shared_memory_act_size shared_memory.c /^get_shared_memory_act_size (int nallocs)$/;" f file: -get_shmem_fd util.c /^get_shmem_fd (void)$/;" f -gfc_coarray_allocation_type wrapper.c /^enum gfc_coarray_allocation_type {$/;" g file: -global_shared_memory_meta shared_memory.c /^} global_shared_memory_meta;$/;" t typeref:struct:__anon18 file: -has_failed_image libcoarraynative.h /^ int has_failed_image;$/;" m struct:__anon9 -has_failed_image master.c /^ int has_failed_image = 0;$/;" m struct:__anon4 file: -hash hashmap.c /^hash (uint64_t key)$/;" f file: -hashmap hashmap.h /^typedef struct hashmap$/;" s -hashmap hashmap.h /^} hashmap;$/;" t typeref:struct:hashmap -hashmap_change_refcnt hashmap.c /^hashmap_change_refcnt (hashmap *hm, memid id, hashmap_search_result *res,$/;" f file: -hashmap_dec hashmap.c /^hashmap_dec (hashmap *hm, memid id, hashmap_search_result * res)$/;" f -hashmap_entry hashmap.c /^} hashmap_entry;$/;" t typeref:struct:__anon13 file: -hashmap_get hashmap.c /^hashmap_get (hashmap *hm, memid id)$/;" f -hashmap_inc hashmap.c /^hashmap_inc (hashmap *hm, memid id, hashmap_search_result * res)$/;" f -hashmap_init hashmap.c /^hashmap_init (hashmap *hm, hashmap_shared *hs, allocator *a,$/;" f -hashmap_search_result hashmap.h /^} hashmap_search_result;$/;" t typeref:struct:__anon15 -hashmap_set hashmap.c /^hashmap_set (hashmap *hm, memid id, hashmap_search_result *hsr,$/;" f -hashmap_shared hashmap.h /^} hashmap_shared;$/;" t typeref:struct:__anon14 -header shared_memory.c /^ void *header;$/;" m struct:shared_memory_act file: -hm alloc.h /^ hashmap hm;$/;" m struct:alloc_iface -hm_search_result_contains hashmap.c /^hm_search_result_contains (hashmap_search_result *res)$/;" f -hm_search_result_ptr hashmap.c /^hm_search_result_ptr (hashmap_search_result *res)$/;" f -hm_search_result_size hashmap.c /^hm_search_result_size (hashmap_search_result *res)$/;" f -hmiadd hashmap.c /^hmiadd (hashmap *hm, size_t s, ssize_t o) {$/;" f file: -hms alloc.h /^ hashmap_shared hms;$/;" m struct:alloc_iface_shared -id hashmap.c /^ memid id;$/;" m struct:__anon13 file: -image libcoarraynative.h /^} image;$/;" t typeref:struct:__anon10 -image_main_wrapper master.c /^image_main_wrapper (void (*image_main) (void), int this_image_num)$/;" f file: -image_num libcoarraynative.h /^ int image_num;$/;" m struct:__anon10 -image_status libcoarraynative.h /^} image_status;$/;" t typeref:enum:__anon7 -image_tracker libcoarraynative.h /^} image_tracker;$/;" t typeref:struct:__anon8 -images libcoarraynative.h /^ image_tracker images[];$/;" m struct:__anon9 -images master.c /^ struct image_status * images;$/;" m struct:__anon4 typeref:struct:__anon4::image_status file: -init_collsub collective_subroutine.c /^init_collsub (void) {$/;" f -init_collsub collective_subroutine.h /^internal_proto (init_collsub);$/;" v -initialize_shared_mutex util.c /^initialize_shared_mutex (pthread_mutex_t *mutex)$/;" f -initialized lock.h /^ int initialized;$/;" m struct:__anon12 -ipcollsub libcoarraynative.h /^} ipcollsub;$/;" t typeref:struct:__anon6 -last_base shared_memory.c /^last_base (shared_memory_act *mem)$/;" f file: -last_seen_size shared_memory.c /^ size_t last_seen_size;$/;" m struct:shared_memory_act file: -local coarraynative.c /^nca_local_data *local = NULL;$/;" v -local_alloc shared_memory.c /^ struct local_alloc {$/;" s struct:shared_memory_act file: -lock alloc.h /^ pthread_mutex_t lock;$/;" m struct:alloc_iface_shared -lock_array lock.h /^} lock_array;$/;" t typeref:struct:__anon12 -lock_table sync.c /^lock_table (sync_iface *si)$/;" f file: -m libcoarraynative.h /^ master *m;$/;" m struct:__anon10 -main malloc_test.c /^int main()$/;" f -map_memory shared_memory.c /^map_memory (int fd, size_t size, off_t offset)$/;" f file: -master libcoarraynative.h /^} master;$/;" t typeref:struct:__anon9 -master master.c /^} master;$/;" t typeref:struct:__anon4 file: -max_lookahead hashmap.c /^ int max_lookahead; $/;" m struct:__anon13 file: -maximg libcoarraynative.h /^ int maximg;$/;" m struct:__anon6 -mem alloc.h /^ shared_memory *mem;$/;" m struct:alloc_iface -memid hashmap.h /^typedef intptr_t memid;$/;" t -meta shared_memory.c /^ global_shared_memory_meta *meta;$/;" m struct:shared_memory_act file: -n_ent hashmap.c /^static ssize_t n_ent;$/;" v file: -nca_co_broadcast collective_subroutine.c /^export_proto (nca_co_broadcast);$/;" v -nca_co_broadcast collective_subroutine.c /^nca_co_broadcast (gfc_array_char * restrict a, int source_image,$/;" f -nca_coarray_alloc wrapper.c /^export_proto (nca_coarray_alloc);$/;" v -nca_coarray_alloc wrapper.c /^nca_coarray_alloc (gfc_array_void *desc, int elem_size, int corank,$/;" f -nca_coarray_free wrapper.c /^export_proto (nca_coarray_free);$/;" v -nca_coarray_free wrapper.c /^nca_coarray_free (gfc_array_void *desc, int alloc_type)$/;" f -nca_coarray_num_images wrapper.c /^export_proto (nca_coarray_num_images);$/;" v -nca_coarray_num_images wrapper.c /^nca_coarray_num_images (int distance __attribute__((unused)))$/;" f -nca_coarray_sync_all wrapper.c /^export_proto (nca_coarray_sync_all);$/;" v -nca_coarray_sync_all wrapper.c /^nca_coarray_sync_all (int *stat __attribute__((unused)))$/;" f -nca_coarray_this_image wrapper.c /^export_proto (nca_coarray_this_image);$/;" v -nca_coarray_this_image wrapper.c /^nca_coarray_this_image (int distance __attribute__((unused)))$/;" f -nca_collsub_reduce_array wrapper.c /^export_proto (nca_collsub_reduce_array);$/;" v -nca_collsub_reduce_array wrapper.c /^nca_collsub_reduce_array (gfc_array_void *desc, void (*assign_function) (void *, void *),$/;" f -nca_collsub_reduce_scalar wrapper.c /^export_proto (nca_collsub_reduce_scalar);$/;" v -nca_collsub_reduce_scalar wrapper.c /^nca_collsub_reduce_scalar (void *obj, index_type elem_size,$/;" f -nca_local_data libcoarraynative.h /^} nca_local_data;$/;" t typeref:struct:__anon11 -nca_lock wrapper.c /^export_proto (nca_lock);$/;" v -nca_lock wrapper.c /^nca_lock (void *lock)$/;" f -nca_master coarraynative.c /^nca_master (void (*image_main) (void)) {$/;" f -nca_master master.c /^nca_master (void (*image_main) (void)) {$/;" f -nca_master master.c /^nca_master (void (*image_main) (void))$/;" f -nca_sync_images wrapper.c /^export_proto (nca_sync_images);$/;" v -nca_sync_images wrapper.c /^nca_sync_images (size_t s, int *images,$/;" f -nca_unlock wrapper.c /^export_proto (nca_unlock);$/;" v -nca_unlock wrapper.c /^nca_unlock (void *lock)$/;" f -new_base_mapping shared_memory.c /^new_base_mapping (shared_memory_act *mem)$/;" f file: -next allocator.c /^ shared_mem_ptr next;$/;" m struct:__anon1 file: -next_power_of_two util.c /^next_power_of_two(size_t size) {$/;" f -num_entries hashmap.c /^num_entries (hashmap_entry *data, size_t size)$/;" f file: -num_images libcoarraynative.h /^ int num_images;$/;" m struct:__anon11 -num_local_allocs shared_memory.c /^ size_t num_local_allocs;$/;" m struct:shared_memory_act file: -offset shared_memory.h /^ ssize_t offset;$/;" m struct:shared_mem_ptr -owner lock.h /^ int owner;$/;" m struct:__anon12 -p hashmap.c /^ shared_mem_ptr p; \/* If p == SHMPTR_NULL, the entry is empty. *\/$/;" m struct:__anon13 file: -p hashmap.h /^ shared_mem_ptr p;$/;" m struct:__anon15 -pagesize util.c /^size_t pagesize = 1<<17;$/;" v -pid libcoarraynative.h /^ pid_t pid;$/;" m struct:__anon8 -prepare_collective_subroutine collective_subroutine.c /^prepare_collective_subroutine (size_t size)$/;" f -prepare_collective_subroutine collective_subroutine.h /^internal_proto (prepare_collective_subroutine);$/;" v -refcnt hashmap.c /^ int refcnt;$/;" m struct:__anon13 file: -res_offset hashmap.h /^ ssize_t res_offset;$/;" m struct:__anon15 -resize_hm hashmap.c /^resize_hm (hashmap *hm, hashmap_entry **data)$/;" f file: -round_to_pagesize util.c /^round_to_pagesize(size_t s) {$/;" f -s allocator.h /^ allocator_shared *s;$/;" m struct:__anon17 -s collective_subroutine.h /^ collsub_iface_shared *s;$/;" m struct:collsub_iface -s hashmap.c /^ size_t s;$/;" m struct:__anon13 file: -s hashmap.h /^ hashmap_shared *s;$/;" m struct:hashmap -scan_empty hashmap.c /^scan_empty (hashmap *hm, ssize_t expected_off, memid id)$/;" f file: -scan_inside_lookahead hashmap.c /^scan_inside_lookahead (hashmap *hm, ssize_t expected_off, memid id)$/;" f file: -serialize_memory serialize.c /^export_proto (serialize_memory);$/;" v -serialize_memory serialize.c /^serialize_memory (gfc_array_char * const restrict source, char *d)$/;" f -shared_free allocator.c /^shared_free (allocator *a, shared_mem_ptr p, size_t size) {$/;" f -shared_malloc allocator.c /^shared_malloc (allocator *a, size_t size)$/;" f -shared_mem_ptr shared_memory.h /^typedef struct shared_mem_ptr$/;" s -shared_mem_ptr shared_memory.h /^} shared_mem_ptr;$/;" t typeref:struct:shared_mem_ptr -shared_mem_ptr_to_void_ptr shared_memory.c /^shared_mem_ptr_to_void_ptr(shared_memory_act **pmem, shared_mem_ptr smp)$/;" f -shared_mem_ptr_to_void_ptr shared_memory.h /^internal_proto (shared_mem_ptr_to_void_ptr);$/;" v -shared_memory shared_memory.h /^typedef struct shared_memory_act * shared_memory;$/;" t typeref:struct:shared_memory_act -shared_memory_act shared_memory.c /^typedef struct shared_memory_act$/;" s file: -shared_memory_act shared_memory.c /^} shared_memory_act;$/;" t typeref:struct:shared_memory_act file: -shared_memory_get_mem_with_alignment shared_memory.c /^shared_memory_get_mem_with_alignment (shared_memory_act **pmem, size_t size,$/;" f -shared_memory_get_mem_with_alignment shared_memory.h /^internal_proto (shared_memory_get_mem_with_alignment);$/;" v -shared_memory_init shared_memory.c /^shared_memory_init (shared_memory_act **pmem)$/;" f -shared_memory_init shared_memory.h /^internal_proto (shared_memory_init);$/;" v -shared_memory_prepare shared_memory.c /^shared_memory_prepare (shared_memory_act **pmem)$/;" f -shared_memory_prepare shared_memory.h /^internal_proto (shared_memory_prepare);$/;" v -shm allocator.h /^ shared_memory *shm;$/;" m struct:__anon17 -si libcoarraynative.h /^ sync_iface si;$/;" m struct:__anon11 -size hashmap.h /^ size_t size;$/;" m struct:__anon14 -size hashmap.h /^ size_t size;$/;" m struct:__anon15 -size shared_memory.c /^ size_t size;$/;" m struct:shared_memory_act::local_alloc file: -size shared_memory.c /^ size_t size;$/;" m struct:__anon18 file: -sm collective_subroutine.h /^ shared_memory *sm;$/;" m struct:collsub_iface -sm hashmap.h /^ shared_memory *sm;$/;" m struct:hashmap -sm libcoarraynative.h /^ shared_memory sm;$/;" m struct:__anon11 -sm sync.h /^ shared_memory *sm;$/;" m struct:__anon3 -status libcoarraynative.h /^ image_status status;$/;" m struct:__anon8 -sync_all sync.c /^sync_all (sync_iface *si)$/;" f -sync_all sync.h /^ pthread_barrier_t sync_all;$/;" m struct:__anon2 -sync_all sync.h /^internal_proto (sync_all);$/;" v -sync_all_init sync.c /^sync_all_init (pthread_barrier_t *b)$/;" f file: -sync_iface sync.h /^} sync_iface;$/;" t typeref:struct:__anon3 -sync_iface_init sync.c /^sync_iface_init (sync_iface *si, alloc_iface *ai, shared_memory *sm)$/;" f -sync_iface_init sync.h /^internal_proto (sync_iface_init);$/;" v -sync_iface_shared sync.h /^} sync_iface_shared;$/;" t typeref:struct:__anon2 -sync_table sync.c /^sync_table (sync_iface *si, int *images, size_t size)$/;" f -sync_table sync.h /^internal_proto (sync_table);$/;" v -table sync.h /^ int *table; \/\/ we can cache the table and the trigger pointers here$/;" m struct:__anon3 -table sync.h /^ shared_mem_ptr table;$/;" m struct:__anon2 -table_lock sync.h /^ pthread_mutex_t table_lock;$/;" m struct:__anon2 -this_image coarraynative.c /^image this_image;$/;" v -triggers sync.h /^ pthread_cond_t *triggers;$/;" m struct:__anon3 -triggers sync.h /^ shared_mem_ptr triggers;$/;" m struct:__anon2 -unlock_table sync.c /^unlock_table (sync_iface *si)$/;" f file: -used shared_memory.c /^ size_t used;$/;" m struct:__anon18 file: -wait_table_cond sync.c /^wait_table_cond (sync_iface *si, pthread_cond_t *cond)$/;" f file: diff --git a/libgfortran/nca/README.native_coarrays b/libgfortran/nca/README.native_coarrays index 6eea35e..02fc013 100644 --- a/libgfortran/nca/README.native_coarrays +++ b/libgfortran/nca/README.native_coarrays @@ -1,35 +1,29 @@ -Each image is its own process, that is forked from the master process -at the start of the program. The number of images is determined by the -environment variable GFORTRAN_NUM_IMAGES or, alternatively, the number -of processors. +Each image is its own process, that is forked from the master process at the +start of the program. The number of images is determined by the environment +variable GFORTRAN_NUM_IMAGES or, alternatively, the number of processors. -Each coarray is identified by its address. Since coarrays always -behave as if they had the SAVE attribute, this works even for -allocatable coarrays. ASLR is not an issue, since the addresses are -assigned at startup and remain valid over forks. If, on two different -images, the allocation function is called with the same descriptor -address, the same piece of memory is allocated. +Each coarray is identified by its address. Since coarrays always behave as if +they had the SAVE attribute, this works even for allocatable coarrays. ASLR is +not an issue, since the addresses are assigned at startup and remain valid over +forks. If, on two different images, the allocation function is called with the +same descriptor address, the same piece of memory is allocated. -Internally, the allocator (alloc.c) uses a shared hashmap (hashmap.c) -to remember with which ids pieces of memory allocated. If a new piece -of memory is needed, a simple relatively allocator (allocator.c) is -used. If the allocator doesn't hold any previously free()d memory, it -requests it from the shared memory object (shared_memory.c), which -also handles the translation of shared_mem_ptr's to pointers in the -address space of the image. At the moment shared_memory relies on -double-mapping pages for this (which might restrict the architectures -on which this will work, I have tested this on x86 and POWER), but -since any piece of memory should only be written to through one -address within one alloc/free pair, it shouldn't matter that much -performance-wise. +Internally, the allocator (alloc.c) uses a shared hashmap (hashmap.c) to +remember with which ids pieces of memory allocated. If a new piece of memory is +needed, a simple relatively allocator (allocator.c) is used. If the allocator +doesn't hold any previously free()d memory, it requests it from the shared +memory object (shared_memory.c), which also handles the translation of +shared_mem_ptr's to pointers in the address space of the image. At the moment +shared_memory relies on double-mapping pages for this (which might restrict the +architectures on which this will work, I have tested this on x86 and POWER), +but since any piece of memory should only be written to through one address +within one alloc/free pair, it shouldn't matter that much performance-wise. -The entry points in the library with the exception of master are -defined in wrapper.c, master(), the function handling launching the -images, is defined in coarraynative.c, and the other files shouldn't -require much explanation. +The entry points in the library with the exception of master are defined in +wrapper.c, master(), the function handling launching the images, is defined in +coarraynative.c, and the other files shouldn't require much explanation. - -To compile a program to run with native coarrays, compile with --fcoarray=shared -lcaf_shared -lrt (I've not yet figured out how to -automagically link against the library). +To compile a program to run with native coarrays, compile with -fcoarray=shared +-lcaf_shared -lrt (I've not yet figured out how to automagically link against +the library if -fcoarray=shared is specified). diff --git a/libgfortran/nca/alloc.c b/libgfortran/nca/alloc.c index 174fe33..b6246d9 100644 --- a/libgfortran/nca/alloc.c +++ b/libgfortran/nca/alloc.c @@ -113,8 +113,9 @@ free_memory_with_id (alloc_iface* iface, memid id) char buffer[100]; snprintf (buffer, sizeof(buffer), "Error in free_memory_with_id: " "%p not found", (void *) id); + /* FIXME: For some reason, internal_error (NULL, buffer) fails to link, + * so we use dprintf at the moment. */ dprintf (2, buffer); - // internal_error (NULL, buffer); exit (1); } diff --git a/libgfortran/nca/coarraynative.c b/libgfortran/nca/coarraynative.c index c9d13ee..109bf88 100644 --- a/libgfortran/nca/coarraynative.c +++ b/libgfortran/nca/coarraynative.c @@ -101,7 +101,7 @@ get_master (void) { argument. It forks the images and waits for their completion. */ void -nca_master (void (*image_main) (void)) { +cas_master (void (*image_main) (void)) { master *m; int i, j; pid_t new; @@ -131,12 +131,19 @@ nca_master (void (*image_main) (void)) { for (i = 0; i < local->num_images; i++) { new = wait (&chstatus); - if (!WIFEXITED (chstatus) || WEXITSTATUS (chstatus)) + if (WIFEXITED (chstatus) && !WEXITSTATUS (chstatus)) + { + j = 0; + for (; j < local->num_images && m->images[j].pid != new; j++); + m->images[j].status = IMAGE_SUCCESS; + m->finished_images++; /* FIXME: Needs to be atomic, probably. */ + } + else if (!WIFEXITED (chstatus) || WEXITSTATUS (chstatus)) { j = 0; for (; j < local->num_images && m->images[j].pid != new; j++); m->images[j].status = IMAGE_FAILED; - m->has_failed_image++; //FIXME: Needs to be atomic, probably + m->has_failed_image++; /* FIXME: Needs to be atomic, probably. */ dprintf (2, "ERROR: Image %d(%#x) failed\n", j, new); exit_code = 1; } diff --git a/libgfortran/nca/collective_inline.h b/libgfortran/nca/collective_inline.h deleted file mode 100644 index 4e7107b..0000000 --- a/libgfortran/nca/collective_inline.h +++ /dev/null @@ -1,42 +0,0 @@ -#include "collective_subroutine.h" - -static inline void -finish_collective_subroutine (collsub_iface *ci) -{ - collsub_sync (ci); -} - -#if 0 -static inline void * -get_obj_ptr (void *buffer, int image) -{ - return (char *) + curr_size * image; -} - -/* If obj is NULL, copy the object from the entry in this image. */ -static inline void -copy_to (void *buffer, void *obj, int image) -{ - if (obj == 0) - obj = get_obj_ptr (this_image.image_num); - memcpy (get_obj_ptr (image), obj, curr_size); -} - -static inline void -copy_out (void *buffer, void *obj, int image) -{ - memcpy (obj, get_obj_ptr (image), curr_size); -} - -static inline void -copy_from (void *buffer, int image) -{ - copy_out (get_obj_ptr (this_image.image_num), image); -} - -static inline void -copy_in (void *buffer, void *obj) -{ - copy_to (obj, this_image.image_num); -} -#endif diff --git a/libgfortran/nca/collective_subroutine.c b/libgfortran/nca/collective_subroutine.c index 8a8a7d6..cc7cbb7 100644 --- a/libgfortran/nca/collective_subroutine.c +++ b/libgfortran/nca/collective_subroutine.c @@ -26,7 +26,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "libgfortran.h" #include "libcoarraynative.h" #include "collective_subroutine.h" -#include "collective_inline.h" #include "allocator.h" void * @@ -35,6 +34,8 @@ get_collsub_buf (collsub_iface *ci, size_t size) void *ret; pthread_mutex_lock (&ci->s->mutex); + /* curr_size is always at least sizeof(double), so we don't need to worry + about size == 0. */ if (size > ci->s->curr_size) { shared_free (ci->a, ci->s->collsub_buf, ci->s->curr_size); @@ -47,18 +48,17 @@ get_collsub_buf (collsub_iface *ci, size_t size) return ret; } -/* It appears as if glibc's barrier implementation does not spin (at - least that is what I got from a quick glance at the source code), - so performance would be improved quite a bit if we spun a few times - here so we don't run into the futex syscall. */ + +/* This function syncs all images with one another. It will only return once + all images have called it. */ void collsub_sync (collsub_iface *ci) { - //dprintf (2, "Calling collsub_sync %d times\n", ++called); pthread_barrier_wait (&ci->s->barrier); } + /* assign_function is needed since we only know how to assign the type inside the compiler. It should be implemented as follows: @@ -103,7 +103,7 @@ collsub_reduce_array (collsub_iface *ci, gfc_array_char *desc, int *result_image imoffset = 1 << cbit; if (this_image.image_num + imoffset < local->num_images) /* Reduce arrays elementwise. */ - for (size_t i = 0; i < pi.num_elem; i++) + for (ssize_t i = 0; i < pi.num_elem; i++) assign_function (this_image_buf + elem_size * i, this_image_buf + this_image_size_bytes * imoffset + elem_size * i); @@ -165,7 +165,6 @@ void collsub_iface_init (collsub_iface *ci, alloc_iface *ai, shared_memory *sm) { pthread_barrierattr_t attr; - shared_mem_ptr p; ci->s = SHARED_MEMORY_RAW_ALLOC_PTR(sm, collsub_iface_shared); ci->s->collsub_buf = shared_malloc(get_allocator(ai), sizeof(double)*local->num_images); @@ -189,8 +188,6 @@ collsub_broadcast_scalar (collsub_iface *ci, void *obj, index_type elem_size, buffer = get_collsub_buf (ci, elem_size); - dprintf(2, "Source image: %d\n", source_image); - if (source_image == this_image.image_num) { memcpy (buffer, obj, elem_size); @@ -214,7 +211,6 @@ collsub_broadcast_array (collsub_iface *ci, gfc_array_char *desc, bool packed; index_type elem_size; index_type size_bytes; - char *this_image_buf; packed = pack_array_prepare (&pi, desc); if (pi.num_elem == 0) @@ -244,173 +240,3 @@ collsub_broadcast_array (collsub_iface *ci, gfc_array_char *desc, finish_collective_subroutine (ci); } - -#if 0 - -void nca_co_broadcast (gfc_array_char *, int, int*, char *, size_t); -export_proto (nca_co_broadcast); - -void -nca_co_broadcast (gfc_array_char * restrict a, int source_image, - int *stat, char *errmsg __attribute__ ((unused)), - size_t errmsg_len __attribute__ ((unused))) -{ - index_type count[GFC_MAX_DIMENSIONS]; - index_type stride[GFC_MAX_DIMENSIONS]; - index_type extent[GFC_MAX_DIMENSIONS]; - index_type type_size; - index_type dim; - index_type span; - bool packed, empty; - index_type num_elems; - index_type ssize, ssize_bytes; - char *this_shared_ptr, *other_shared_ptr; - - if (stat) - *stat = 0; - - dim = GFC_DESCRIPTOR_RANK (a); - type_size = GFC_DESCRIPTOR_SIZE (a); - - /* Source image, gather. */ - if (source_image - 1 == image_num) - { - num_elems = 1; - if (dim > 0) - { - span = a->span != 0 ? a->span : type_size; - packed = true; - empty = false; - for (index_type n = 0; n < dim; n++) - { - count[n] = 0; - stride[n] = GFC_DESCRIPTOR_STRIDE (a, n) * span; - extent[n] = GFC_DESCRIPTOR_EXTENT (a, n); - - empty = empty || extent[n] <= 0; - - if (num_elems != GFC_DESCRIPTOR_STRIDE (a, n)) - packed = false; - - num_elems *= extent[n]; - } - ssize_bytes = num_elems * type_size; - } - else - { - ssize_bytes = type_size; - packed = true; - empty = false; - } - - prepare_collective_subroutine (ssize_bytes); // broadcast barrier 1 - this_shared_ptr = get_obj_ptr (image_num); - if (packed) - memcpy (this_shared_ptr, a->base_addr, ssize_bytes); - else - { - char *src = (char *) a->base_addr; - char * restrict dest = this_shared_ptr; - index_type stride0 = stride[0]; - - while (src) - { - /* Copy the data. */ - - memcpy (dest, src, type_size); - dest += type_size; - src += stride0; - count[0] ++; - /* Advance to the next source element. */ - for (index_type n = 0; count[n] == extent[n] ; ) - { - /* When we get to the end of a dimension, reset it - and increment the next dimension. */ - count[n] = 0; - src -= stride[n] * extent[n]; - n++; - if (n == dim) - { - src = NULL; - break; - } - else - { - count[n]++; - src += stride[n]; - } - } - } - } - collsub_sync (ci); /* Broadcast barrier 2. */ - } - else /* Target image, scatter. */ - { - collsub_sync (ci); /* Broadcast barrier 1. */ - packed = 1; - num_elems = 1; - span = a->span != 0 ? a->span : type_size; - - for (index_type n = 0; n < dim; n++) - { - index_type stride_n; - count[n] = 0; - stride_n = GFC_DESCRIPTOR_STRIDE (a, n); - stride[n] = stride_n * type_size; - extent[n] = GFC_DESCRIPTOR_EXTENT (a, n); - if (extent[n] <= 0) - { - packed = true; - num_elems = 0; - break; - } - if (num_elems != stride_n) - packed = false; - - num_elems *= extent[n]; - } - ssize = num_elems * type_size; - prepare_collective_subroutine (ssize); /* Broadcaset barrier 2. */ - other_shared_ptr = get_obj_ptr (source_image - 1); - if (packed) - memcpy (a->base_addr, other_shared_ptr, ssize); - else - { - char *src = other_shared_ptr; - char * restrict dest = (char *) a->base_addr; - index_type stride0 = stride[0]; - - for (index_type n = 0; n < dim; n++) - count[n] = 0; - - while (dest) - { - memcpy (dest, src, type_size); - src += span; - dest += stride0; - count[0] ++; - for (index_type n = 0; count[n] == extent[n] ;) - { - /* When we get to the end of a dimension, reset it and increment - the next dimension. */ - count[n] = 0; - dest -= stride[n] * extent[n]; - n++; - if (n == dim) - { - dest = NULL; - break; - } - else - { - count[n]++; - dest += stride[n]; - } - } - } - } - } - finish_collective_subroutine (ci); /* Broadcast barrier 3. */ -} - -#endif diff --git a/libgfortran/nca/collective_subroutine.h b/libgfortran/nca/collective_subroutine.h index 6147dd6..2793116 100644 --- a/libgfortran/nca/collective_subroutine.h +++ b/libgfortran/nca/collective_subroutine.h @@ -41,4 +41,15 @@ internal_proto (collsub_iface_init); void * get_collsub_buf (collsub_iface *ci, size_t size); internal_proto (get_collsub_buf); + + +/* Needed to prevent one image starting the next collective subroutine before + * everyone has finished the current one. At the moment, this is just an alias + * for collsub_sync, but there might be more work to do later. */ + +static inline void +finish_collective_subroutine(collsub_iface *ci) { + collsub_sync(ci); +} + #endif diff --git a/libgfortran/nca/hashmap.c b/libgfortran/nca/hashmap.c index 61f5487..865ec6a 100644 --- a/libgfortran/nca/hashmap.c +++ b/libgfortran/nca/hashmap.c @@ -43,7 +43,7 @@ typedef struct { static ssize_t num_entries (hashmap_entry *data, size_t size) { - ssize_t i; + size_t i; ssize_t ret = 0; for (i = 0; i < size; i++) { @@ -88,13 +88,16 @@ hash (uint64_t key) return key; } + /* Gets a pointer to the current data in the hashmap. */ + static inline hashmap_entry * get_data(hashmap *hm) { return SHMPTR_AS (hashmap_entry *, hm->s->data, hm->sm); } + /* Generate mask from current number of bits. */ static inline intptr_t @@ -103,6 +106,7 @@ gen_mask (hashmap *hm) return (1 << hm->s->bitnum) - 1; } + /* Add with wrap-around at hashmap size. */ static inline size_t @@ -110,6 +114,7 @@ hmiadd (hashmap *hm, size_t s, ssize_t o) { return (s + o) & gen_mask (hm); } + /* Get the expected offset for entry id. */ static inline ssize_t @@ -118,6 +123,7 @@ get_expected_offset (hashmap *hm, memid id) return hash(id) >> (PTR_BITS - hm->s->bitnum); } + /* Initialize the hashmap. */ void @@ -139,6 +145,7 @@ hashmap_init (hashmap *hm, hashmap_shared *hs, allocator *a, hm->a = a; } + /* This checks if the entry id exists in that range the range between the expected position and the maximum lookahead. */ @@ -160,11 +167,12 @@ scan_inside_lookahead (hashmap *hm, ssize_t expected_off, memid id) return -1; } + /* Scan for the next empty slot we can use. Returns offset relative to the expected position. */ static ssize_t -scan_empty (hashmap *hm, ssize_t expected_off, memid id) +scan_empty (hashmap *hm, ssize_t expected_off) { hashmap_entry *data; @@ -176,6 +184,7 @@ scan_empty (hashmap *hm, ssize_t expected_off, memid id) return -1; } + /* Search the hashmap for id. */ hashmap_search_result @@ -199,13 +208,16 @@ hashmap_get (hashmap *hm, memid id) return ret; } + /* Return size of a hashmap search result. */ + size_t hm_search_result_size (hashmap_search_result *res) { return res->size; } + /* Return pointer of a hashmap search result. */ shared_mem_ptr @@ -214,6 +226,7 @@ hm_search_result_ptr (hashmap_search_result *res) return res->p; } + /* Return pointer of a hashmap search result. */ bool @@ -222,6 +235,7 @@ hm_search_result_contains (hashmap_search_result *res) return !SHMPTR_IS_NULL(res->p); } + /* Enlarge hashmap memory. */ static void @@ -234,7 +248,6 @@ enlarge_hashmap_mem (hashmap *hm, hashmap_entry **data, bool f) old_size = hm->s->size; hm->s->data = shared_malloc (hm->a, (hm->s->size *= 2)*sizeof(hashmap_entry)); - fprintf (stderr,"enlarge_hashmap_mem: %ld\n", hm->s->data.offset); hm->s->bitnum++; *data = get_data(hm); @@ -246,6 +259,7 @@ enlarge_hashmap_mem (hashmap *hm, hashmap_entry **data, bool f) shared_free(hm->a, old_data_p, old_size); } + /* Resize hashmap. */ static void @@ -257,7 +271,6 @@ resize_hm (hashmap *hm, hashmap_entry **data) ssize_t new_offset, inital_index, new_index; memid id; ssize_t max_lookahead; - ssize_t old_count, new_count; /* old_data points to the old block containing the hashmap. We redistribute the data from there into the new block. */ @@ -265,14 +278,8 @@ resize_hm (hashmap *hm, hashmap_entry **data) old_data_p = hm->s->data; old_data = *data; old_size = hm->s->size; - old_count = num_entries (old_data, old_size); - fprintf(stderr, "Occupancy at resize: %f\n", ((double) old_count)/old_size); - - //fprintf (stderr,"\n====== Resizing hashmap =========\n\nOld map:\n\n"); - //dump_hm (hm); enlarge_hashmap_mem (hm, &new_data, false); - //fprintf (stderr,"old_data: %p new_data: %p\n", old_data, new_data); retry_resize: for (size_t i = 0; i < old_size; i++) { @@ -281,15 +288,13 @@ resize_hm (hashmap *hm, hashmap_entry **data) id = old_data[i].id; inital_index = get_expected_offset (hm, id); - new_offset = scan_empty (hm, inital_index, id); + new_offset = scan_empty (hm, inital_index); /* If we didn't find a free slot, just resize the hashmap again. */ if (new_offset == -1) { enlarge_hashmap_mem (hm, &new_data, true); - //fprintf (stderr,"\n====== AGAIN Resizing hashmap =========\n\n"); - //fprintf (stderr,"old_data: %p new_data %p\n", old_data, new_data); goto retry_resize; /* Sue me. */ } @@ -304,15 +309,11 @@ resize_hm (hashmap *hm, hashmap_entry **data) .max_lookahead = new_data[new_index].max_lookahead, .refcnt = old_data[i].refcnt}); } - new_count = num_entries (new_data, hm->s->size); - //fprintf (stderr,"Number of elements: %ld to %ld\n", old_count, new_count); - //fprintf (stderr,"============ After resizing: =======\n\n"); - //dump_hm (hm); - shared_free (hm->a, old_data_p, old_size); *data = new_data; } + /* Set an entry in the hashmap. */ void @@ -324,7 +325,6 @@ hashmap_set (hashmap *hm, memid id, hashmap_search_result *hsr, ssize_t empty_offset; ssize_t delta; - // //fprintf (stderr,"hashmap_set: id = %-16p\n", (void *) id); data = get_data(hm); if (hsr) { @@ -334,7 +334,7 @@ hashmap_set (hashmap *hm, memid id, hashmap_search_result *hsr, } expected_offset = get_expected_offset (hm, id); - while ((delta = scan_empty (hm, expected_offset, id)) == -1) + while ((delta = scan_empty (hm, expected_offset)) == -1) { resize_hm (hm, &data); expected_offset = get_expected_offset (hm, id); @@ -348,10 +348,6 @@ hashmap_set (hashmap *hm, memid id, hashmap_search_result *hsr, .refcnt = 1}); n_ent ++; - fprintf (stderr,"hashmap_set: Setting %p at %p, n_ent = %ld\n", (void *) id, data + empty_offset, - n_ent); - // dump_hm (hm); - // fprintf(stderr, "--------------------------------------------------\n"); /* TODO: Shouldn't reset refcnt, but this doesn't matter at the moment because of the way the function is used. */ } @@ -382,9 +378,7 @@ hashmap_change_refcnt (hashmap *hm, memid id, hashmap_search_result *res, ret = (entry->refcnt += delta); if (ret == 0) { - n_ent --; - //fprintf (stderr, "hashmap_change_refcnt: removing %p at %p, n_ent = %ld\n", - // (void *) id, entry, n_ent); + n_ent--; entry->id = 0; entry->p = SHMPTR_NULL; entry->s = 0; @@ -393,6 +387,7 @@ hashmap_change_refcnt (hashmap *hm, memid id, hashmap_search_result *res, return ret; } + /* Increase hashmap entry refcount. */ void @@ -403,6 +398,7 @@ hashmap_inc (hashmap *hm, memid id, hashmap_search_result * res) ASSERT_HM (hm, ret > 0); } + /* Decrease hashmap entry refcount. */ int diff --git a/libgfortran/nca/hashmap.h b/libgfortran/nca/hashmap.h index 4d999e3..2949095 100644 --- a/libgfortran/nca/hashmap.h +++ b/libgfortran/nca/hashmap.h @@ -1,3 +1,27 @@ +/* Copyright (C) 2020 Free Software Foundation, Inc. + Contributed by Nicolas Koenig + +This file is part of the GNU Fortran Native Coarray Library (libnca). + +Libnca is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libnca is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + #ifndef HASHMAP_H #include "shared_memory.h" diff --git a/libgfortran/nca/libcoarraynative.h b/libgfortran/nca/libcoarraynative.h index 507de0c..85746f3 100644 --- a/libgfortran/nca/libcoarraynative.h +++ b/libgfortran/nca/libcoarraynative.h @@ -22,10 +22,6 @@ a copy of the GCC Runtime Library Exception along with this program; see the files COPYING3 and COPYING.RUNTIME respectively. If not, see <http://www.gnu.org/licenses/>. */ -#ifndef LIBGFOR_H -#error "Include libgfortran.h before libcoarraynative.h" -#endif - #ifndef COARRAY_NATIVE_HDR #define COARRAY_NATIVE_HDR @@ -35,16 +31,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <stdint.h> #include <stdio.h> +#define DEBUG_NATIVE_COARRAY 0 -/* This is to create a _nca_gfortrani_ prefix for all variables and - function used only by nca. */ -#if 0 -#define NUM_ADDR_BITS (8 * sizeof (int *)) -#endif - -#define DEBUG_NATIVE_COARRAY 1 - -#ifdef DEBUG_NATIVE_COARRAY +#if defined(DEBUG_NATIVE_COARRAY) && DEBUG_NATIVE_COARRAY #define DEBUG_PRINTF(...) dprintf (2,__VA_ARGS__) #else #define DEBUG_PRINTF(...) do {} while(0) @@ -64,7 +53,8 @@ typedef struct { typedef enum { IMAGE_UNKNOWN = 0, IMAGE_OK, - IMAGE_FAILED + IMAGE_FAILED, + IMAGE_SUCCESS } image_status; typedef struct { @@ -74,6 +64,7 @@ typedef struct { typedef struct { int has_failed_image; + int finished_images; image_tracker images[]; } master; @@ -97,7 +88,7 @@ internal_proto (local); void ensure_initialization(void); internal_proto(ensure_initialization); -void nca_master(void (*)(void)); -export_proto (nca_master); +void cas_master(void (*)(void)); +export_proto (cas_master); #endif diff --git a/libgfortran/nca/shared_memory.c b/libgfortran/nca/shared_memory.c index bc3093d..7d68126 100644 --- a/libgfortran/nca/shared_memory.c +++ b/libgfortran/nca/shared_memory.c @@ -141,7 +141,6 @@ shared_memory_get_mem_with_alignment (shared_memory_act **pmem, size_t size, memset(last_base(mem) + used_wa, 0x42, size); mem->meta->used = used_wa + size; - DEBUG_PRINTF ("Shared Memory: New memory of size %#lx requested, returned %#lx\n", size, used_wa); return (shared_mem_ptr) {.offset = used_wa}; } @@ -165,7 +164,6 @@ shared_memory_get_mem_with_alignment (shared_memory_act **pmem, size_t size, *pmem = mem; assert(used_wa != 0); - dprintf(2, "Shared Memory: New memory of size %#lx requested, returned %#lx\n", size, used_wa); memset(last_base(mem) + orig_used, 0xCA, used_wa - orig_used); memset(last_base(mem) + used_wa, 0x42, size); diff --git a/libgfortran/nca/shared_memory.h b/libgfortran/nca/shared_memory.h index 4adc104..5912368 100644 --- a/libgfortran/nca/shared_memory.h +++ b/libgfortran/nca/shared_memory.h @@ -23,6 +23,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see <http://www.gnu.org/licenses/>. */ #ifndef SHARED_MEMORY_H +#define SHARED_MEMORY_H + #include <stdbool.h> #include <stdint.h> #include <stddef.h> @@ -74,5 +76,4 @@ internal_proto (shared_memory_get_mem_with_alignment); void *shared_mem_ptr_to_void_ptr (shared_memory *, shared_mem_ptr); internal_proto (shared_mem_ptr_to_void_ptr); -#define SHARED_MEMORY_H #endif diff --git a/libgfortran/nca/sync.c b/libgfortran/nca/sync.c index 6d7f7ca..cd30f2f 100644 --- a/libgfortran/nca/sync.c +++ b/libgfortran/nca/sync.c @@ -59,35 +59,9 @@ wait_table_cond (sync_iface *si, pthread_cond_t *cond) } static int * -get_locked_table(sync_iface *si) { // The initialization of the table has to - // be delayed, since we might not know the - // number of images when the library is - // initialized +get_locked_table(sync_iface *si) { lock_table(si); return si->table; - /* - if (si->table) - return si->table; - else if (!SHMPTR_IS_NULL(si->cis->table)) - { - si->table = SHMPTR_AS(int *, si->cis->table, si->sm); - si->triggers = SHMPTR_AS(pthread_cond_t *, si->cis->triggers, si->sm); - return si->table; - } - - si->cis->table = - shared_malloc(si->a, sizeof(int)*local->num_images * local->num_images); - si->cis->triggers = - shared_malloc(si->a, sizeof(int)*local->num_images); - - si->table = SHMPTR_AS(int *, si->cis->table, si->sm); - si->triggers = SHMPTR_AS(pthread_cond_t *, si->cis->triggers, si->sm); - - for (int i = 0; i < local->num_images; i++) - initialize_shared_condition (&si->triggers[i]); - - return si->table; - */ } void @@ -97,7 +71,6 @@ sync_iface_init (sync_iface *si, alloc_iface *ai, shared_memory *sm) shared_malloc (get_allocator(ai), sizeof(collsub_iface_shared)), sm); - DEBUG_PRINTF ("%s: num_images is %d\n", __PRETTY_FUNCTION__, local->num_images); sync_all_init (&si->cis->sync_all); initialize_shared_mutex (&si->cis->table_lock); @@ -119,9 +92,9 @@ sync_iface_init (sync_iface *si, alloc_iface *ai, shared_memory *sm) void sync_table (sync_iface *si, int *images, size_t size) { -#ifdef DEBUG_NATIVE_COARRAY +#if defined(DEBUG_NATIVE_COARRAY) && DEBUG_NATIVE_COARRAY dprintf (2, "Image %d waiting for these %ld images: ", this_image.image_num + 1, size); - for (int d_i = 0; d_i < size; d_i++) + for (int d_i = 0; (size_t) d_i < size; d_i++) dprintf (2, "%d ", images[d_i]); dprintf (2, "\n"); #endif @@ -150,7 +123,5 @@ void sync_all (sync_iface *si) { - DEBUG_PRINTF("Syncing all\n"); - pthread_barrier_wait (&si->cis->sync_all); } diff --git a/libgfortran/nca/sync.h b/libgfortran/nca/sync.h index 4b49441..6eec14e 100644 --- a/libgfortran/nca/sync.h +++ b/libgfortran/nca/sync.h @@ -27,7 +27,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "shared_memory.h" #include "alloc.h" -#include<pthread.h> +#include <pthread.h> typedef struct { pthread_barrier_t sync_all; diff --git a/libgfortran/nca/util.c b/libgfortran/nca/util.c index 5805218..758e87f 100644 --- a/libgfortran/nca/util.c +++ b/libgfortran/nca/util.c @@ -9,7 +9,11 @@ #include <fcntl.h> #include <sys/mman.h> #include <sys/stat.h> +#include <assert.h> +/* Shared Memory objects live in their own namspace (usually found under + * /dev/shm/), so the "/" is needed. It is for some reason impossible to create + * a shared memory object without name. */ #define MEMOBJ_NAME "/gfortran_coarray_memfd" size_t @@ -26,7 +30,8 @@ round_to_pagesize(size_t s) { size_t next_power_of_two(size_t size) { - return 1 << (PTR_BITS - __builtin_clzl(size-1)); //FIXME: There's an off-by-one error, I can feel it + assert(size); + return 1 << (PTR_BITS - __builtin_clzl(size-1)); } void @@ -120,7 +125,7 @@ pack_array_finish (pack_info * const restrict pi, const gfc_array_char * const r stride0 = pi->stride[0]; size = GFC_DESCRIPTOR_SIZE (source); - memset (count, 0, sizeof(count)); + memset (count, '\0', sizeof (count) * dim); while (src) { /* Copy the data. */ @@ -170,6 +175,8 @@ unpack_array_finish (pack_info * const restrict pi, dest = d->base_addr; dim = GFC_DESCRIPTOR_RANK (d); + + memset(count, '\0', sizeof(count) * dim); while (dest) { memcpy (dest, src, size); diff --git a/libgfortran/nca/wrapper.c b/libgfortran/nca/wrapper.c index eeb64d3..b31e750 100644 --- a/libgfortran/nca/wrapper.c +++ b/libgfortran/nca/wrapper.c @@ -36,55 +36,58 @@ div_ru (int divident, int divisor) return (divident + divisor - 1)/divisor; } +/* Need to keep this in sync with + trans-array.h:gfc_coarray_allocation_type. */ + enum gfc_coarray_allocation_type { - GFC_NCA_NORMAL_COARRAY = 3, + GFC_NCA_NORMAL_COARRAY = 1, GFC_NCA_LOCK_COARRAY, GFC_NCA_EVENT_COARRAY, }; -void nca_coarray_alloc (gfc_array_void *, int, int, int); -export_proto (nca_coarray_alloc); +void cas_coarray_alloc (gfc_array_void *, int, int, int); +export_proto (cas_coarray_alloc); void -nca_coarray_free (gfc_array_void *, int); -export_proto (nca_coarray_free); +cas_coarray_free (gfc_array_void *, int); +export_proto (cas_coarray_free); -int nca_coarray_this_image (int); -export_proto (nca_coarray_this_image); +int cas_coarray_this_image (int); +export_proto (cas_coarray_this_image); -int nca_coarray_num_images (int); -export_proto (nca_coarray_num_images); +int cas_coarray_num_images (int); +export_proto (cas_coarray_num_images); -void nca_coarray_sync_all (int *); -export_proto (nca_coarray_sync_all); +void cas_coarray_sync_all (int *); +export_proto (cas_coarray_sync_all); -void nca_sync_images (size_t, int *, int*, char *, size_t); -export_proto (nca_sync_images); +void cas_sync_images (size_t, int *, int*, char *, size_t); +export_proto (cas_sync_images); -void nca_lock (void *); -export_proto (nca_lock); +void cas_lock (void *); +export_proto (cas_lock); -void nca_unlock (void *); -export_proto (nca_unlock); +void cas_unlock (void *); +export_proto (cas_unlock); -void nca_collsub_reduce_array (gfc_array_char *, void (*) (void *, void *), +void cas_collsub_reduce_array (gfc_array_char *, void (*) (void *, void *), int *); -export_proto (nca_collsub_reduce_array); +export_proto (cas_collsub_reduce_array); -void nca_collsub_reduce_scalar (void *, index_type, void (*) (void *, void *), +void cas_collsub_reduce_scalar (void *, index_type, void (*) (void *, void *), int *); -export_proto (nca_collsub_reduce_scalar); +export_proto (cas_collsub_reduce_scalar); -void nca_collsub_broadcast_array (gfc_array_char * restrict, int/*, int *, char *, +void cas_collsub_broadcast_array (gfc_array_char * restrict, int/*, int *, char *, size_t*/); -export_proto (nca_collsub_broadcast_array); +export_proto (cas_collsub_broadcast_array); -void nca_collsub_broadcast_scalar (void * restrict, size_t, int/*, int *, char *, +void cas_collsub_broadcast_scalar (void * restrict, size_t, int/*, int *, char *, size_t*/); -export_proto(nca_collsub_broadcast_scalar); +export_proto(cas_collsub_broadcast_scalar); void -nca_coarray_alloc (gfc_array_void *desc, int elem_size, int corank, +cas_coarray_alloc (gfc_array_void *desc, int elem_size, int corank, int alloc_type) { int i, last_rank_index; @@ -153,11 +156,10 @@ nca_coarray_alloc (gfc_array_void *desc, int elem_size, int corank, else desc->base_addr = get_memory_by_id (&local->ai, size_in_bytes, (intptr_t) desc); - dprintf(2, "Base address of desc for image %d: %p\n", this_image.image_num + 1, desc->base_addr); } void -nca_coarray_free (gfc_array_void *desc, int alloc_type) +cas_coarray_free (gfc_array_void *desc, int alloc_type) { int i; if (alloc_type == GFC_NCA_LOCK_COARRAY) @@ -186,25 +188,25 @@ nca_coarray_free (gfc_array_void *desc, int alloc_type) } int -nca_coarray_this_image (int distance __attribute__((unused))) +cas_coarray_this_image (int distance __attribute__((unused))) { return this_image.image_num + 1; } int -nca_coarray_num_images (int distance __attribute__((unused))) +cas_coarray_num_images (int distance __attribute__((unused))) { return local->num_images; } void -nca_coarray_sync_all (int *stat __attribute__((unused))) +cas_coarray_sync_all (int *stat __attribute__((unused))) { sync_all (&local->si); } void -nca_sync_images (size_t s, int *images, +cas_sync_images (size_t s, int *images, int *stat __attribute__((unused)), char *error __attribute__((unused)), size_t err_size __attribute__((unused))) @@ -213,26 +215,26 @@ nca_sync_images (size_t s, int *images, } void -nca_lock (void *lock) +cas_lock (void *lock) { pthread_mutex_lock (lock); } void -nca_unlock (void *lock) +cas_unlock (void *lock) { pthread_mutex_unlock (lock); } void -nca_collsub_reduce_array (gfc_array_char *desc, void (*assign_function) (void *, void *), +cas_collsub_reduce_array (gfc_array_char *desc, void (*assign_function) (void *, void *), int *result_image) { collsub_reduce_array (&local->ci, desc, result_image, assign_function); } void -nca_collsub_reduce_scalar (void *obj, index_type elem_size, +cas_collsub_reduce_scalar (void *obj, index_type elem_size, void (*assign_function) (void *, void *), int *result_image) { @@ -240,7 +242,7 @@ nca_collsub_reduce_scalar (void *obj, index_type elem_size, } void -nca_collsub_broadcast_array (gfc_array_char * restrict a, int source_image +cas_collsub_broadcast_array (gfc_array_char * restrict a, int source_image /* , int *stat __attribute__ ((unused)), char *errmsg __attribute__ ((unused)), size_t errmsg_len __attribute__ ((unused))*/) @@ -249,7 +251,7 @@ nca_collsub_broadcast_array (gfc_array_char * restrict a, int source_image } void -nca_collsub_broadcast_scalar (void * restrict obj, size_t size, int source_image/*, +cas_collsub_broadcast_scalar (void * restrict obj, size_t size, int source_image/*, int *stat __attribute__((unused)), char *errmsg __attribute__ ((unused)), size_t errmsg_len __attribute__ ((unused))*/) |