This patch ports another* patch from the Fortran-caf branch to the
trunk; it only affects -fcoarray=lib. An earlier patch was posted
before,** remains unreviewed and is replaced by this patch (re-diffed,
minutely enhanced).
Besides some minor clean-up in libgfortran/caf, the patch changes the
handling of this_image()/num_images(). The current code on the trunk
calls "caf_init" in the main program - and uses this to obtain the value
of this_images()/num_images(). The values are then stored in global
variables.
That procedure has two disadvantages:
a) If one uses coarrays only in some parts of the program (e.g. in a
library) and not in the main program, "caf_init" will never be called
and one refers to a nonexisting variable (link-time failure). [Okay, one
could require that that the main program is compiled with -fcoarray=lib
or the user calls "caf_init" manually, e.g. if the code is some C code
linking to a Fortran program.]
b) The Technical Specification (TS) 18508 "Additional Parallel Features
in Fortran"***, which extends the coarray support, will support teams.
When changing to a new team (CHANGE TEAM), this_image and num_images
change but the current scheme does not support this.
Thus, the patch removes the static variables and calls a library
function. The only down side is that this will lead to some missed
optimization cases, when one calls multiple times to
this_image()/num_images() in an expression. But I think that can be
better be solved in the front-end optimization pass.
Note that TS18508's this_image() is not only able to return the image
index of the current team but also its index in the n-th ancestor team
(optional "distance" argument). Similarly, num_images() takes an
optional "distance" argument - and an optional Boolean argument, which
requests to return the number of failed images. Thus, to prepare for
TS18508, the attached patch also adds the additional arguments. (The
optional coarray array argument of this_image() was and will be handled
in the front-end itself.)
Built and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
* The first patch was:
http://gcc.gnu.org/ml/gcc-patches/2014-04/msg01769.html
** http://gcc.gnu.org/ml/fortran/2014-03/msg00030.html
*** Current draft: ftp://ftp.nag.co.uk/sc22wg5/N2001-N2050/N2007.pdf ;
latest status (also known as ballot):
ftp://ftp.nag.co.uk/sc22wg5/N2001-N2050/N2013.txt - however, those
comments do not affect this patch.
PS: I am aware of at least three patches which someone (I?) should
review; I will try to find some time for those.
2014-04-27 Tobias Burnus <bur...@net-b.de>
* gfortran.h (gfc_init_coarray_decl): Remove.
* parse.c (translate_all_program_units): Remove call to it.
(gfc_parse_file): Update call.
* trans.h (gfor_fndecl_caf_this_image,
gfor_fndecl_caf_num_images): Add.
(gfort_gvar_caf_num_images,
gfort_gvar_caf_this_image): Remove.
* trans-decl.c (gfor_fndecl_caf_this_image,
gfor_fndecl_caf_num_images): Add.
(gfort_gvar_caf_num_images,
gfort_gvar_caf_this_image): Remove.
(gfc_build_builtin_function_decls): Init new decl.
(gfc_init_coarray_dec): Remove.
(create_main_function): Change calls.
* trans-intrinsic.c (trans_this_image, trans_image_index,
conv_intrinsic_cobound): Generate call to new library function
instead of to a static variable.
* trans-stmt.c (gfc_trans_sync): Ditto.
2014-04-27 Tobias Burnus <bur...@net-b.de>
* gfortran.dg/coarray_lib_this_image_1.f90: New.
* gfortran.dg/coarray_lib_this_image_2.f90: New.
2014-03-08 Tobias Burnus <bur...@net-b.de>
* caf/libcaf.h (_gfortran_caf_this_image, _gfortran_caf_num_images):
New prototypes.
(_gfortran_caf_init): Change prototype.
(mpi_token_t): New typedef.
(TOKEN): New define.
* caf/mpi.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
New functions.
(_gfortran_caf_init): Update.
(_gfortran_caf_finalize, _gfortran_caf_register,
_gfortran_caf_deregister): Use mpi_token_t.
* caf/single.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
New functions.
(_gfortran_caf_init): Update.
(_gfortran_caf_finalize, _gfortran_caf_register,
_gfortran_caf_deregister): Use mpi_token_t, simplify.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f0eed80..0707b58 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2948,7 +2948,6 @@ bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
/* trans.c */
void gfc_generate_code (gfc_namespace *);
void gfc_generate_module_code (gfc_namespace *);
-void gfc_init_coarray_decl (bool);
/* trans-intrinsic.c */
bool gfc_inline_intrinsic_function_p (gfc_expr *);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0faf47a..7766715 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4495,19 +4495,13 @@ clean_up_modules (gfc_gsymbol *gsym)
/* Translate all the program units. This could be in a different order
to resolution if there are forward references in the file. */
static void
-translate_all_program_units (gfc_namespace *gfc_global_ns_list,
- bool main_in_tu)
+translate_all_program_units (gfc_namespace *gfc_global_ns_list)
{
int errors;
gfc_current_ns = gfc_global_ns_list;
gfc_get_errors (NULL, &errors);
- /* If the main program is in the translation unit and we have
- -fcoarray=libs, generate the static variables. */
- if (gfc_option.coarray == GFC_FCOARRAY_LIB && main_in_tu)
- gfc_init_coarray_decl (true);
-
/* We first translate all modules to make sure that later parts
of the program can use the decl. Then we translate the nonmodules. */
@@ -4729,7 +4723,7 @@ prog_units:
}
/* Do the translation. */
- translate_all_program_units (gfc_global_ns_list, seen_program);
+ translate_all_program_units (gfc_global_ns_list);
gfc_end_source_files ();
return true;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cf7b661..c835a3b 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -121,6 +121,8 @@ tree gfor_fndecl_associated;
/* Coarray run-time library function decls. */
tree gfor_fndecl_caf_init;
tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_this_image;
+tree gfor_fndecl_caf_num_images;
tree gfor_fndecl_caf_register;
tree gfor_fndecl_caf_deregister;
tree gfor_fndecl_caf_critical;
@@ -130,11 +132,6 @@ tree gfor_fndecl_caf_sync_images;
tree gfor_fndecl_caf_error_stop;
tree gfor_fndecl_caf_error_stop_str;
-/* Coarray global variables for num_images/this_image. */
-
-tree gfort_gvar_caf_num_images;
-tree gfort_gvar_caf_this_image;
-
/* Math functions. Many other math functions are handled in
trans-intrinsic.c. */
@@ -3247,6 +3244,14 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
+ gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
+ get_identifier (PREFIX("caf_this_image")), integer_type_node,
+ 1, integer_type_node);
+
+ gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
+ get_identifier (PREFIX("caf_num_images")), integer_type_node,
+ 2, integer_type_node, boolean_type_node);
+
gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
size_type_node, integer_type_node, ppvoid_type_node, pint_type,
@@ -5105,59 +5110,6 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
}
-/* Generate the _gfortran_caf_this_image and _gfortran_caf_num_images
- global variables for -fcoarray=lib. They are placed into the translation
- unit of the main program. Make sure that in one TU (the one of the main
- program), the first call to gfc_init_coarray_decl is done with true.
- Otherwise, expect link errors. */
-
-void
-gfc_init_coarray_decl (bool main_tu)
-{
- if (gfc_option.coarray != GFC_FCOARRAY_LIB)
- return;
-
- if (gfort_gvar_caf_this_image || gfort_gvar_caf_num_images)
- return;
-
- push_cfun (cfun);
-
- gfort_gvar_caf_this_image
- = build_decl (input_location, VAR_DECL,
- get_identifier (PREFIX("caf_this_image")),
- integer_type_node);
- DECL_ARTIFICIAL (gfort_gvar_caf_this_image) = 1;
- TREE_USED (gfort_gvar_caf_this_image) = 1;
- TREE_PUBLIC (gfort_gvar_caf_this_image) = 1;
- TREE_READONLY (gfort_gvar_caf_this_image) = 0;
-
- if (main_tu)
- TREE_STATIC (gfort_gvar_caf_this_image) = 1;
- else
- DECL_EXTERNAL (gfort_gvar_caf_this_image) = 1;
-
- pushdecl_top_level (gfort_gvar_caf_this_image);
-
- gfort_gvar_caf_num_images
- = build_decl (input_location, VAR_DECL,
- get_identifier (PREFIX("caf_num_images")),
- integer_type_node);
- DECL_ARTIFICIAL (gfort_gvar_caf_num_images) = 1;
- TREE_USED (gfort_gvar_caf_num_images) = 1;
- TREE_PUBLIC (gfort_gvar_caf_num_images) = 1;
- TREE_READONLY (gfort_gvar_caf_num_images) = 0;
-
- if (main_tu)
- TREE_STATIC (gfort_gvar_caf_num_images) = 1;
- else
- DECL_EXTERNAL (gfort_gvar_caf_num_images) = 1;
-
- pushdecl_top_level (gfort_gvar_caf_num_images);
-
- pop_cfun ();
-}
-
-
static void
create_main_function (tree fndecl)
{
@@ -5237,7 +5189,7 @@ create_main_function (tree fndecl)
/* Call some libgfortran initialization routines, call then MAIN__(). */
- /* Call _gfortran_caf_init (*argc, ***argv, *this_image, *num_images). */
+ /* Call _gfortran_caf_init (*argc, ***argv). */
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
{
tree pint_type, pppchar_type;
@@ -5245,12 +5197,9 @@ create_main_function (tree fndecl)
pppchar_type
= build_pointer_type (build_pointer_type (pchar_type_node));
- gfc_init_coarray_decl (true);
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 4,
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 2,
gfc_build_addr_expr (pint_type, argc),
- gfc_build_addr_expr (pppchar_type, argv),
- gfc_build_addr_expr (pint_type, gfort_gvar_caf_this_image),
- gfc_build_addr_expr (pint_type, gfort_gvar_caf_num_images));
+ gfc_build_addr_expr (pppchar_type, argv));
gfc_add_expr_to_block (&body, tmp);
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 070b64e..e13c0de 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -937,13 +937,13 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
/* The case -fcoarray=single is handled elsewhere. */
gcc_assert (gfc_option.coarray != GFC_FCOARRAY_SINGLE);
- gfc_init_coarray_decl (false);
-
/* Argument-free version: THIS_IMAGE(). */
if (expr->value.function.actual->expr == NULL)
{
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+ integer_zero_node);
se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
- gfort_gvar_caf_this_image);
+ tmp);
return;
}
@@ -1039,9 +1039,10 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
*/
/* this_image () - 1. */
- tmp = fold_convert (type, gfort_gvar_caf_this_image);
- tmp = fold_build2_loc (input_location, MINUS_EXPR, type, tmp,
- build_int_cst (type, 1));
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+ integer_zero_node);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, type,
+ fold_convert (type, tmp), build_int_cst (type, 1));
if (corank == 1)
{
/* sub(1) = m + lcobound(corank). */
@@ -1244,8 +1245,10 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
num_images = build_int_cst (type, 1);
else
{
- gfc_init_coarray_decl (false);
- num_images = fold_convert (type, gfort_gvar_caf_num_images);
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+ integer_zero_node,
+ build_int_cst (integer_type_node, -1));
+ num_images = fold_convert (type, tmp);
}
tmp = gfc_create_var (type, NULL);
@@ -1264,9 +1267,10 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
static void
trans_num_images (gfc_se * se)
{
- gfc_init_coarray_decl (false);
- se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
- gfort_gvar_caf_num_images);
+ tree tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+ integer_zero_node,
+ build_int_cst (integer_type_node, -1));
+ se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
}
@@ -1607,13 +1611,13 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
tree cosize;
- gfc_init_coarray_decl (false);
cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
-
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+ 2, integer_zero_node,
+ build_int_cst (integer_type_node, -1));
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
- fold_convert (gfc_array_index_type,
- gfort_gvar_caf_num_images),
+ fold_convert (gfc_array_index_type, tmp),
build_int_cst (gfc_array_index_type, 1));
tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
gfc_array_index_type, tmp,
@@ -1624,11 +1628,12 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
else if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
{
/* ubound = lbound + num_images() - 1. */
- gfc_init_coarray_decl (false);
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+ 2, integer_zero_node,
+ build_int_cst (integer_type_node, -1));
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
- fold_convert (gfc_array_index_type,
- gfort_gvar_caf_num_images),
+ fold_convert (gfc_array_index_type, tmp),
build_int_cst (gfc_array_index_type, 1));
resbound = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, resbound, tmp);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 00c99fc..212a258 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -784,8 +784,11 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
else
{
tree cond2;
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+ 2, integer_zero_node,
+ build_int_cst (integer_type_node, -1));
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
- images, gfort_gvar_caf_num_images);
+ images, tmp);
cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
images,
build_int_cst (TREE_TYPE (images), 1));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 243feb7..f693712 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1303,7 +1303,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
- int n;
+ int n, corank;
+
+ /* Assumed-shape arrays do not have codimension information stored in the
+ descriptor. */
+ corank = as->corank;
+ if (as->type == AS_ASSUMED_SHAPE ||
+ (as->type == AS_ASSUMED_RANK && akind == GFC_ARRAY_ALLOCATABLE))
+ corank = 0;
if (as->type == AS_ASSUMED_RANK)
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
@@ -1322,14 +1329,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
- for (n = as->rank; n < as->rank + as->corank; n++)
+ for (n = as->rank; n < as->rank + corank; n++)
{
if (as->type != AS_DEFERRED && as->lower[n] == NULL)
lbound[n] = gfc_index_one_node;
else
lbound[n] = gfc_conv_array_bound (as->lower[n]);
- if (n < as->rank + as->corank - 1)
+ if (n < as->rank + corank - 1)
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
@@ -1341,7 +1348,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
: GFC_ARRAY_ASSUMED_RANK;
return gfc_get_array_type_bounds (type, as->rank == -1
? GFC_MAX_DIMENSIONS : as->rank,
- as->corank, lbound,
+ corank, lbound,
ubound, 0, akind, restricted);
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f8d29ec..13b0a00 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -699,6 +699,8 @@ extern GTY(()) tree gfor_fndecl_associated;
/* Coarray run-time library function decls. */
extern GTY(()) tree gfor_fndecl_caf_init;
extern GTY(()) tree gfor_fndecl_caf_finalize;
+extern GTY(()) tree gfor_fndecl_caf_this_image;
+extern GTY(()) tree gfor_fndecl_caf_num_images;
extern GTY(()) tree gfor_fndecl_caf_register;
extern GTY(()) tree gfor_fndecl_caf_deregister;
extern GTY(()) tree gfor_fndecl_caf_critical;
@@ -708,10 +710,6 @@ extern GTY(()) tree gfor_fndecl_caf_sync_images;
extern GTY(()) tree gfor_fndecl_caf_error_stop;
extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
-/* Coarray global variables for num_images/this_image. */
-extern GTY(()) tree gfort_gvar_caf_num_images;
-extern GTY(()) tree gfort_gvar_caf_this_image;
-
/* Math functions. Many other math functions are handled in
trans-intrinsic.c. */
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 7ecd76f..8b8fd3e 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -26,8 +26,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#ifndef LIBCAF_H
#define LIBCAF_H
+#include <stdbool.h>
+#include <stddef.h> /* For size_t. */
#include <stdint.h> /* For int32_t. */
-#include <stddef.h> /* For ptrdiff_t. */
#ifndef __GNUC__
#define __attribute__(x)
@@ -55,21 +56,25 @@ typedef enum caf_register_t {
}
caf_register_t;
+typedef void* caf_token_t;
+
/* Linked list of static coarrays registered. */
typedef struct caf_static_t {
- void **token;
+ caf_token_t token;
struct caf_static_t *prev;
}
caf_static_t;
-void _gfortran_caf_init (int *, char ***, int *, int *);
+void _gfortran_caf_init (int *, char ***);
void _gfortran_caf_finalize (void);
-void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void ***, int *,
- char *, int);
-void _gfortran_caf_deregister (void ***, int *, char *, int);
+int _gfortran_caf_this_image (int);
+int _gfortran_caf_num_images (int, bool);
+void *_gfortran_caf_register (size_t, caf_register_t, caf_token_t *, int *,
+ char *, int);
+void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
void _gfortran_caf_sync_all (int *, char *, int);
void _gfortran_caf_sync_images (int, int[], int *, char *, int);
diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c
index da7185e..fe2baf4 100644
--- a/libgfortran/caf/mpi.c
+++ b/libgfortran/caf/mpi.c
@@ -34,6 +34,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
/* Define GFC_CAF_CHECK to enable run-time checking. */
/* #define GFC_CAF_CHECK 1 */
+typedef void ** mpi_token_t;
+#define TOKEN(X) ((mpi_token_t) (X))
static void error_stop (int error) __attribute__ ((noreturn));
@@ -73,7 +75,7 @@ caf_runtime_error (const char *message, ...)
libaray is initialized. */
void
-_gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
+_gfortran_caf_init (int *argc, char ***argv)
{
if (caf_num_images == 0)
{
@@ -87,11 +89,6 @@ _gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
MPI_Comm_rank (MPI_COMM_WORLD, &caf_this_image);
caf_this_image++;
}
-
- if (this_image)
- *this_image = caf_this_image;
- if (num_images)
- *num_images = caf_num_images;
}
@@ -104,8 +101,8 @@ _gfortran_caf_finalize (void)
{
caf_static_t *tmp = caf_static_list->prev;
- free (caf_static_list->token[caf_this_image-1]);
- free (caf_static_list->token);
+ free (TOKEN (caf_static_list->token)[caf_this_image-1]);
+ free (TOKEN (caf_static_list->token));
free (caf_static_list);
caf_static_list = tmp;
}
@@ -117,8 +114,23 @@ _gfortran_caf_finalize (void)
}
+int
+_gfortran_caf_this_image (int distance __attribute__ ((unused)))
+{
+ return caf_this_image;
+}
+
+
+int
+_gfortran_caf_num_images (int distance __attribute__ ((unused)),
+ bool failed __attribute__ ((unused)))
+{
+ return caf_num_images;
+}
+
+
void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
+_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
int *stat, char *errmsg, int errmsg_len)
{
void *local;
@@ -129,17 +141,17 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
/* Start MPI if not already started. */
if (caf_num_images == 0)
- _gfortran_caf_init (NULL, NULL, NULL, NULL);
+ _gfortran_caf_init (NULL, NULL);
/* Token contains only a list of pointers. */
local = malloc (size);
- *token = malloc (sizeof (void*) * caf_num_images);
+ *token = malloc (sizeof (mpi_token_t) * caf_num_images);
if (unlikely (local == NULL || *token == NULL))
goto error;
/* token[img-1] is the address of the token in image "img". */
- err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, *token,
+ err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, TOKEN (*token),
sizeof (void*), MPI_BYTE, MPI_COMM_WORLD);
if (unlikely (err))
@@ -192,7 +204,7 @@ error:
void
-_gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len)
+_gfortran_caf_deregister (caf_token_t *token, int *stat, char *errmsg, int errmsg_len)
{
if (unlikely (caf_is_finalized))
{
@@ -220,7 +232,7 @@ _gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len
if (stat)
*stat = 0;
- free ((*token)[caf_this_image-1]);
+ free (TOKEN (*token)[caf_this_image-1]);
free (*token);
}
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 551b9aa..cf1ced8 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -32,6 +32,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
/* Define GFC_CAF_CHECK to enable run-time checking. */
/* #define GFC_CAF_CHECK 1 */
+typedef void* single_token_t;
+#define TOKEN(X) ((single_token_t) (X))
+
/* Single-image implementation of the CAF library.
Note: For performance reasons -fcoarry=single should be used
rather than this library. */
@@ -57,11 +60,8 @@ caf_runtime_error (const char *message, ...)
void
_gfortran_caf_init (int *argc __attribute__ ((unused)),
- char ***argv __attribute__ ((unused)),
- int *this_image, int *num_images)
+ char ***argv __attribute__ ((unused)))
{
- *this_image = 1;
- *num_images = 1;
}
@@ -71,7 +71,6 @@ _gfortran_caf_finalize (void)
while (caf_static_list != NULL)
{
caf_static_t *tmp = caf_static_list->prev;
- free (caf_static_list->token[0]);
free (caf_static_list->token);
free (caf_static_list);
caf_static_list = tmp;
@@ -79,15 +78,29 @@ _gfortran_caf_finalize (void)
}
+int
+_gfortran_caf_this_image (int distance __attribute__ ((unused)))
+{
+ return 1;
+}
+
+
+int
+_gfortran_caf_num_images (int distance __attribute__ ((unused)),
+ bool failed __attribute__ ((unused)))
+{
+ return 1;
+}
+
+
void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
+_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
int *stat, char *errmsg, int errmsg_len)
{
void *local;
local = malloc (size);
- *token = malloc (sizeof (void*) * 1);
- (*token)[0] = local;
+ *token = malloc (sizeof (single_token_t));
if (unlikely (local == NULL || token == NULL))
{
@@ -109,6 +122,8 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
caf_runtime_error (msg);
}
+ *token = local;
+
if (stat)
*stat = 0;
@@ -124,12 +139,11 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
void
-_gfortran_caf_deregister (void ***token, int *stat,
+_gfortran_caf_deregister (caf_token_t *token, int *stat,
char *errmsg __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused)))
{
- free ((*token)[0]);
- free (*token);
+ free (TOKEN(*token));
if (stat)
*stat = 0;
--- /dev/null 2014-04-23 17:58:54.386702372 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 2014-04-27 18:16:26.759409523 +0200
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+
+ implicit none
+ real :: x(2)[*]
+ call bar(x)
+contains
+ subroutine bar(x)
+ integer :: mylcobound, myucobound, mylbound, mythis_image
+ real :: x(2)[5:*]
+ mylcobound = lcobound(x,dim=1)
+ myucobound = ucobound(x,dim=1)
+ mylbound = lbound(x,dim=1)
+ mythis_image = this_image()
+ end subroutine bar
+end
+
+! { dg1final { scan-tree-dump-times "bar \\(real\\(kind=4\\)\\[2\\] \\* restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
+! { dg.final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(x, caf_token.., 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null 2014-04-23 17:58:54.386702372 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 2014-04-27 18:23:19.496694840 +0200
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+
+ implicit none
+ real :: x(2)[*]
+ call bar(x)
+contains
+ subroutine bar(x)
+ integer :: mylcobound, myucobound, mylbound, mythis_image
+ real :: x(:)[5:*]
+ mylcobound = lcobound(x,dim=1)
+ myucobound = ucobound(x,dim=1)
+ mylbound = lbound(x,dim=1)
+ mythis_image = this_image()
+ end subroutine bar
+end
+
+! { dg-final { scan-tree-dump-times "bar \\(struct array2_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
+! { dg2final { scan-tree-dump-times "mylbound = parm...dim\\\[0\\\].stride >= 0 && parm...dim\\\[0\\\].ubound >= parm...dim\\\[0\\\].lbound || parm...dim\\[0\\].stride < 0 \\? \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound : 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=8\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=8\\)\\) x\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
