procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gfortran.h (gfc_init_coarray_decl): Remove.

Browse source 
2014-04-30  Tobias Burnus  <burnus@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-30  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_lib_this_image_1.f90: New.
        * gfortran.dg/coarray_lib_this_image_2.f90: New.

2014-04-30  Tobias Burnus  <burnus@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.

From-SVN: r209951
This commit is contained in:
Tobias Burnus 2014-04-30 21:02:23 +02:00 • committed by Tobias Burnus
parent 7f36b65d25
commit a8a5f4a972
15 changed files with 215 additions and 131 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
gcc/fortran/ChangeLog
View file

@ -1,3 +1,24 @@
2014-04-30 Tobias Burnus <burnus@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-30 Tobias Burnus <burnus@net-b.de>
* trans-expr.c (get_tree_for_caf_expr): Fix handling of polymorphic

1
gcc/fortran/gfortran.h
View file

@ -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 *);

10
gcc/fortran/parse.c
View file

@ -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;

77
gcc/fortran/trans-decl.c
View file

@ -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);
}

41
gcc/fortran/trans-intrinsic.c
View file

@ -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);

5
gcc/fortran/trans-stmt.c
View file

@ -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));

15
gcc/fortran/trans-types.c
View file

@ -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);
}

6
gcc/fortran/trans.h
View file

@ -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. */

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2014-04-30 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_lib_this_image_1.f90: New.
* gfortran.dg/coarray_lib_this_image_2.f90: New.
2014-04-30 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_poly_4.f90: New.

27
gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 Normal file
View file

@ -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
! { dg-final { 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" } }

27
gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 Normal file
View file

@ -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" } }
! { dg-final { 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" } }

18
libgfortran/ChangeLog
View file

@ -1,3 +1,21 @@
2014-04-30 Tobias Burnus <burnus@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.
2014-04-26 Jerry DeLisle <jvdelisle@gcc.gnu>
PR libfortran/52539

17
libgfortran/caf/libcaf.h
View file

@ -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);

40
libgfortran/caf/mpi.c
View file

@ -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);
}

36
libgfortran/caf/single.c
View file

@ -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;