re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
2011-03-27 Tobias Burnus <burnus@net-b.de> PR fortran/18918 * gfortran.h (gfc_isym_id): Rename GFC_ISYM_NUMIMAGES to GFC_ISYM_NUM_IMAGES. (gfc_fcoarray): Add GFC_FCOARRAY_LIB. * intrinsic.c (add_functions): Update due to GFC_ISYM_NUM_IMAGES rename. * invoke.texi (-fcoarray=): Document "lib" argument. * iresolve.c (gfc_resolve_this_image): Fix THIS IMAGE(). * libgfortran.h (libgfortran_stat_codes): Add comments. * options.c (gfc_handle_coarray_option): Add -fcoarray=lib. * simplify.c (gfc_simplify_num_images, gfc_simplify_this_image): Handle GFC_FCOARRAY_LIB. * trans.h (gfc_init_coarray_decl): New prototype. (gfor_fndecl_caf_init, gfor_fndecl_caf_finalize, gfor_fndecl_caf_critical, gfor_fndecl_caf_end_critical, gfor_fndecl_caf_sync_all, gfor_fndecl_caf_sync_images, gfor_fndecl_caf_error_stop, gfor_fndecl_caf_error_stop_str, gfort_gvar_caf_num_images, gfort_gvar_caf_this_image): New global variables. * trans-decl.c: Declare several CAF functions (cf. above). (gfc_build_builtin_function_decls): Initialize those. (gfc_init_coarray_decl): New function. (create_main_function): Call CAF init/finalize functions. * trans-intrinsic.c (trans_this_image, trans_num_images): New. (gfc_conv_intrinsic_function): Call those. * trans-stmt.c (gfc_trans_stop, gfc_trans_sync, * gfc_trans_critical): Add code for GFC_FCOARRAY_LIB. From-SVN: r171568
This commit is contained in:
parent
46ae608f26
commit
60386f50ce
|
@ -1,3 +1,33 @@
|
|||
2011-03-27 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/18918
|
||||
* gfortran.h (gfc_isym_id): Rename GFC_ISYM_NUMIMAGES to
|
||||
GFC_ISYM_NUM_IMAGES.
|
||||
(gfc_fcoarray): Add GFC_FCOARRAY_LIB.
|
||||
* intrinsic.c (add_functions): Update due to GFC_ISYM_NUM_IMAGES
|
||||
rename.
|
||||
* invoke.texi (-fcoarray=): Document "lib" argument.
|
||||
* iresolve.c (gfc_resolve_this_image): Fix THIS IMAGE().
|
||||
* libgfortran.h (libgfortran_stat_codes): Add comments.
|
||||
* options.c (gfc_handle_coarray_option): Add -fcoarray=lib.
|
||||
* simplify.c (gfc_simplify_num_images, gfc_simplify_this_image):
|
||||
Handle GFC_FCOARRAY_LIB.
|
||||
* trans.h (gfc_init_coarray_decl): New prototype.
|
||||
(gfor_fndecl_caf_init, gfor_fndecl_caf_finalize,
|
||||
gfor_fndecl_caf_critical, gfor_fndecl_caf_end_critical,
|
||||
gfor_fndecl_caf_sync_all, gfor_fndecl_caf_sync_images,
|
||||
gfor_fndecl_caf_error_stop, gfor_fndecl_caf_error_stop_str,
|
||||
gfort_gvar_caf_num_images, gfort_gvar_caf_this_image):
|
||||
New global variables.
|
||||
* trans-decl.c: Declare several CAF functions (cf. above).
|
||||
(gfc_build_builtin_function_decls): Initialize those.
|
||||
(gfc_init_coarray_decl): New function.
|
||||
(create_main_function): Call CAF init/finalize functions.
|
||||
* trans-intrinsic.c (trans_this_image, trans_num_images): New.
|
||||
(gfc_conv_intrinsic_function): Call those.
|
||||
* trans-stmt.c (gfc_trans_stop, gfc_trans_sync, gfc_trans_critical):
|
||||
Add code for GFC_FCOARRAY_LIB.
|
||||
|
||||
2011-03-26 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
PR fortran/48291
|
||||
|
|
|
@ -458,7 +458,7 @@ enum gfc_isym_id
|
|||
GFC_ISYM_NORM2,
|
||||
GFC_ISYM_NOT,
|
||||
GFC_ISYM_NULL,
|
||||
GFC_ISYM_NUMIMAGES,
|
||||
GFC_ISYM_NUM_IMAGES,
|
||||
GFC_ISYM_OR,
|
||||
GFC_ISYM_PACK,
|
||||
GFC_ISYM_PARITY,
|
||||
|
@ -572,7 +572,8 @@ init_local_integer;
|
|||
typedef enum
|
||||
{
|
||||
GFC_FCOARRAY_NONE = 0,
|
||||
GFC_FCOARRAY_SINGLE
|
||||
GFC_FCOARRAY_SINGLE,
|
||||
GFC_FCOARRAY_LIB
|
||||
}
|
||||
gfc_fcoarray;
|
||||
|
||||
|
|
|
@ -2358,7 +2358,8 @@ add_functions (void)
|
|||
|
||||
make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
|
||||
|
||||
add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
|
||||
add_sym_0 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_INQUIRY, ACTUAL_NO,
|
||||
BT_INTEGER, di, GFC_STD_F2008,
|
||||
NULL, gfc_simplify_num_images, NULL);
|
||||
|
||||
add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
|
||||
|
|
|
@ -166,7 +166,7 @@ and warnings}.
|
|||
-fwhole-file -fsecond-underscore @gol
|
||||
-fbounds-check -fcheck-array-temporaries -fmax-array-constructor =@var{n} @gol
|
||||
-fcheck=@var{<all|array-temps|bounds|do|mem|pointer|recursion>} @gol
|
||||
-fcoarray=@var{<none|single>} -fmax-stack-var-size=@var{n} @gol
|
||||
-fcoarray=@var{<none|single|lib>} -fmax-stack-var-size=@var{n} @gol
|
||||
-fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol
|
||||
-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
|
||||
-finit-integer=@var{n} -finit-real=@var{<zero|inf|-inf|nan|snan>} @gol
|
||||
|
@ -1249,6 +1249,10 @@ statements will produce a compile-time error. (Default)
|
|||
|
||||
@item @samp{single}
|
||||
Single-image mode, i.e. @code{num_images()} is always one.
|
||||
|
||||
@item @samp{lib}
|
||||
Library-based coarray parallelization; a suitable GNU Fortran coarray
|
||||
library needs to be linked.
|
||||
@end table
|
||||
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
/* Intrinsic function resolution.
|
||||
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
||||
2009, 2010
|
||||
2009, 2010, 2011
|
||||
Free Software Foundation, Inc.
|
||||
Contributed by Andy Vaught & Katherine Holcomb
|
||||
|
||||
|
@ -2556,7 +2556,15 @@ gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
|
|||
void
|
||||
gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
|
||||
{
|
||||
static char this_image[] = "__this_image";
|
||||
if (array)
|
||||
resolve_bound (f, array, dim, NULL, "__this_image", true);
|
||||
else
|
||||
{
|
||||
f->ts.type = BT_INTEGER;
|
||||
f->ts.kind = gfc_default_integer_kind;
|
||||
f->value.function.name = this_image;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
/* Header file to the Fortran front-end and runtime library
|
||||
Copyright (C) 2007, 2008, 2009, 2010
|
||||
Copyright (C) 2007, 2008, 2009, 2010, 2011
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of GCC.
|
||||
|
@ -98,12 +98,13 @@ typedef enum
|
|||
}
|
||||
libgfortran_error_codes;
|
||||
|
||||
/* Must kept in sync with libgfortrancaf.h. */
|
||||
typedef enum
|
||||
{
|
||||
GFC_STAT_UNLOCKED = 0,
|
||||
GFC_STAT_LOCKED,
|
||||
GFC_STAT_LOCKED_OTHER_IMAGE,
|
||||
GFC_STAT_STOPPED_IMAGE
|
||||
GFC_STAT_STOPPED_IMAGE /* See LIBERROR_INQUIRE_INTERNAL_UNIT above. */
|
||||
}
|
||||
libgfortran_stat_codes;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
/* Parse and display command line options.
|
||||
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
||||
2009, 2010
|
||||
2009, 2010, 2011
|
||||
Free Software Foundation, Inc.
|
||||
Contributed by Andy Vaught
|
||||
|
||||
|
@ -516,6 +516,8 @@ gfc_handle_coarray_option (const char *arg)
|
|||
gfc_option.coarray = GFC_FCOARRAY_NONE;
|
||||
else if (strcmp (arg, "single") == 0)
|
||||
gfc_option.coarray = GFC_FCOARRAY_SINGLE;
|
||||
else if (strcmp (arg, "lib") == 0)
|
||||
gfc_option.coarray = GFC_FCOARRAY_LIB;
|
||||
else
|
||||
gfc_fatal_error ("Argument to -fcoarray is not valid: %s", arg);
|
||||
}
|
||||
|
|
|
@ -4591,6 +4591,9 @@ gfc_simplify_num_images (void)
|
|||
return &gfc_bad_expr;
|
||||
}
|
||||
|
||||
if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
|
||||
return NULL;
|
||||
|
||||
/* FIXME: gfc_current_locus is wrong. */
|
||||
result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
|
||||
&gfc_current_locus);
|
||||
|
@ -6313,6 +6316,9 @@ gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim)
|
|||
gfc_array_spec *as;
|
||||
int d;
|
||||
|
||||
if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
|
||||
return NULL;
|
||||
|
||||
if (coarray == NULL)
|
||||
{
|
||||
gfc_expr *result;
|
||||
|
|
|
@ -111,6 +111,22 @@ tree gfor_fndecl_in_unpack;
|
|||
tree gfor_fndecl_associated;
|
||||
|
||||
|
||||
/* Coarray run-time library function decls. */
|
||||
tree gfor_fndecl_caf_init;
|
||||
tree gfor_fndecl_caf_finalize;
|
||||
tree gfor_fndecl_caf_critical;
|
||||
tree gfor_fndecl_caf_end_critical;
|
||||
tree gfor_fndecl_caf_sync_all;
|
||||
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. */
|
||||
|
||||
|
@ -3003,6 +3019,50 @@ gfc_build_builtin_function_decls (void)
|
|||
DECL_PURE_P (gfor_fndecl_associated) = 1;
|
||||
TREE_NOTHROW (gfor_fndecl_associated) = 1;
|
||||
|
||||
/* Coarray library calls. */
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
|
||||
{
|
||||
tree pint_type, pppchar_type;
|
||||
|
||||
pint_type = build_pointer_type (integer_type_node);
|
||||
pppchar_type
|
||||
= build_pointer_type (build_pointer_type (pchar_type_node));
|
||||
|
||||
gfor_fndecl_caf_init = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("caf_init")), void_type_node,
|
||||
4, pint_type, pppchar_type, pint_type, pint_type);
|
||||
|
||||
gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
|
||||
|
||||
gfor_fndecl_caf_critical = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("caf_critical")), void_type_node, 0);
|
||||
|
||||
gfor_fndecl_caf_end_critical = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("caf_end_critical")), void_type_node, 0);
|
||||
|
||||
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("caf_sync_all")), ".W", integer_type_node,
|
||||
2, build_pointer_type (pchar_type_node), integer_type_node);
|
||||
|
||||
gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("caf_sync_images")), ".RRW", integer_type_node,
|
||||
4, integer_type_node, pint_type, build_pointer_type (pchar_type_node),
|
||||
integer_type_node);
|
||||
|
||||
gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("caf_error_stop")),
|
||||
void_type_node, 1, gfc_int4_type_node);
|
||||
/* CAF's ERROR STOP doesn't return. */
|
||||
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop) = 1;
|
||||
|
||||
gfor_fndecl_caf_error_stop_str = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("caf_error_stop_str")), ".R.",
|
||||
void_type_node, 2, pchar_type_node, gfc_int4_type_node);
|
||||
/* CAF's ERROR STOP doesn't return. */
|
||||
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
|
||||
}
|
||||
|
||||
gfc_build_intrinsic_function_decls ();
|
||||
gfc_build_intrinsic_lib_fndecls ();
|
||||
gfc_build_io_library_fndecls ();
|
||||
|
@ -4405,6 +4465,40 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
|
|||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_init_coarray_decl (void)
|
||||
{
|
||||
tree save_fn_decl = current_function_decl;
|
||||
|
||||
if (gfc_option.coarray != GFC_FCOARRAY_LIB)
|
||||
return;
|
||||
|
||||
if (gfort_gvar_caf_this_image || gfort_gvar_caf_num_images)
|
||||
return;
|
||||
|
||||
save_fn_decl = current_function_decl;
|
||||
current_function_decl = NULL_TREE;
|
||||
push_cfun (cfun);
|
||||
|
||||
gfort_gvar_caf_this_image = gfc_create_var (integer_type_node,
|
||||
PREFIX("caf_this_image"));
|
||||
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_STATIC (gfort_gvar_caf_this_image) = 1;
|
||||
|
||||
gfort_gvar_caf_num_images = gfc_create_var (integer_type_node,
|
||||
PREFIX("caf_num_images"));
|
||||
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_STATIC (gfort_gvar_caf_num_images) = 1;
|
||||
|
||||
pop_cfun ();
|
||||
current_function_decl = save_fn_decl;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
create_main_function (tree fndecl)
|
||||
{
|
||||
|
@ -4484,6 +4578,23 @@ create_main_function (tree fndecl)
|
|||
|
||||
/* Call some libgfortran initialization routines, call then MAIN__(). */
|
||||
|
||||
/* Call _gfortran_caf_init (*argc, ***argv, *this_image, *num_images). */
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
|
||||
{
|
||||
tree pint_type, pppchar_type;
|
||||
pint_type = build_pointer_type (integer_type_node);
|
||||
pppchar_type
|
||||
= build_pointer_type (build_pointer_type (pchar_type_node));
|
||||
|
||||
gfc_init_coarray_decl ();
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 4,
|
||||
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_add_expr_to_block (&body, tmp);
|
||||
}
|
||||
|
||||
/* Call _gfortran_set_args (argc, argv). */
|
||||
TREE_USED (argc) = 1;
|
||||
TREE_USED (argv) = 1;
|
||||
|
@ -4601,6 +4712,19 @@ create_main_function (tree fndecl)
|
|||
/* Mark MAIN__ as used. */
|
||||
TREE_USED (fndecl) = 1;
|
||||
|
||||
/* Coarray: Call _gfortran_caf_finalize(void). */
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
|
||||
{
|
||||
/* Per F2008, 8.5.1 END of the main program implies a
|
||||
SYNC MEMORY. */
|
||||
tmp = built_in_decls [BUILT_IN_SYNCHRONIZE];
|
||||
tmp = build_call_expr_loc (input_location, tmp, 0);
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_finalize, 0);
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
}
|
||||
|
||||
/* "return 0". */
|
||||
tmp = fold_build2_loc (input_location, MODIFY_EXPR, integer_type_node,
|
||||
DECL_RESULT (ftn_main),
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
/* Intrinsic translation
|
||||
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
|
||||
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
|
||||
Free Software Foundation, Inc.
|
||||
Contributed by Paul Brook <paul@nowt.org>
|
||||
and Steven Bosscher <s.bosscher@student.tudelft.nl>
|
||||
|
@ -918,6 +918,20 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
|
|||
se->expr = fold_convert (type, res);
|
||||
}
|
||||
|
||||
static void
|
||||
trans_this_image (gfc_se * se, gfc_expr *expr ATTRIBUTE_UNUSED)
|
||||
{
|
||||
gfc_init_coarray_decl ();
|
||||
se->expr = gfort_gvar_caf_this_image;
|
||||
}
|
||||
|
||||
static void
|
||||
trans_num_images (gfc_se * se)
|
||||
{
|
||||
gfc_init_coarray_decl ();
|
||||
se->expr = gfort_gvar_caf_num_images;
|
||||
}
|
||||
|
||||
/* Evaluate a single upper or lower bound. */
|
||||
/* TODO: bound intrinsic generates way too much unnecessary code. */
|
||||
|
||||
|
@ -6111,6 +6125,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
|
|||
gfc_conv_intrinsic_loc (se, expr);
|
||||
break;
|
||||
|
||||
case GFC_ISYM_THIS_IMAGE:
|
||||
trans_this_image (se, expr);
|
||||
break;
|
||||
|
||||
case GFC_ISYM_NUM_IMAGES:
|
||||
trans_num_images (se);
|
||||
break;
|
||||
|
||||
case GFC_ISYM_ACCESS:
|
||||
case GFC_ISYM_CHDIR:
|
||||
case GFC_ISYM_CHMOD:
|
||||
|
|
|
@ -599,11 +599,25 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
|
|||
gfc_init_se (&se, NULL);
|
||||
gfc_start_block (&se.pre);
|
||||
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB && !error_stop)
|
||||
{
|
||||
/* Per F2008, 8.5.1 STOP implies a SYNC MEMORY. */
|
||||
tmp = built_in_decls [BUILT_IN_SYNCHRONIZE];
|
||||
tmp = build_call_expr_loc (input_location, tmp, 0);
|
||||
gfc_add_expr_to_block (&se.pre, tmp);
|
||||
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_finalize, 0);
|
||||
gfc_add_expr_to_block (&se.pre, tmp);
|
||||
}
|
||||
|
||||
if (code->expr1 == NULL)
|
||||
{
|
||||
tmp = build_int_cst (gfc_int4_type_node, 0);
|
||||
tmp = build_call_expr_loc (input_location,
|
||||
error_stop ? gfor_fndecl_error_stop_string
|
||||
error_stop
|
||||
? (gfc_option.coarray == GFC_FCOARRAY_LIB
|
||||
? gfor_fndecl_caf_error_stop_str
|
||||
: gfor_fndecl_error_stop_string)
|
||||
: gfor_fndecl_stop_string,
|
||||
2, build_int_cst (pchar_type_node, 0), tmp);
|
||||
}
|
||||
|
@ -611,7 +625,10 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
|
|||
{
|
||||
gfc_conv_expr (&se, code->expr1);
|
||||
tmp = build_call_expr_loc (input_location,
|
||||
error_stop ? gfor_fndecl_error_stop_numeric
|
||||
error_stop
|
||||
? (gfc_option.coarray == GFC_FCOARRAY_LIB
|
||||
? gfor_fndecl_caf_error_stop
|
||||
: gfor_fndecl_error_stop_numeric)
|
||||
: gfor_fndecl_stop_numeric_f08, 1,
|
||||
fold_convert (gfc_int4_type_node, se.expr));
|
||||
}
|
||||
|
@ -619,7 +636,10 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
|
|||
{
|
||||
gfc_conv_expr_reference (&se, code->expr1);
|
||||
tmp = build_call_expr_loc (input_location,
|
||||
error_stop ? gfor_fndecl_error_stop_string
|
||||
error_stop
|
||||
? (gfc_option.coarray == GFC_FCOARRAY_LIB
|
||||
? gfor_fndecl_caf_error_stop_str
|
||||
: gfor_fndecl_error_stop_string)
|
||||
: gfor_fndecl_stop_string,
|
||||
2, se.expr, se.string_length);
|
||||
}
|
||||
|
@ -633,14 +653,51 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
|
|||
|
||||
|
||||
tree
|
||||
gfc_trans_sync (gfc_code *code, gfc_exec_op type __attribute__ ((unused)))
|
||||
gfc_trans_sync (gfc_code *code, gfc_exec_op type)
|
||||
{
|
||||
gfc_se se;
|
||||
gfc_se se, argse;
|
||||
tree tmp;
|
||||
tree images = NULL_TREE, stat = NULL_TREE,
|
||||
errmsg = NULL_TREE, errmsglen = NULL_TREE;
|
||||
|
||||
/* Short cut: For single images without bound checking or without STAT=,
|
||||
return early. (ERRMSG= is always untouched for -fcoarray=single.) */
|
||||
if (!code->expr2 && !(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
&& gfc_option.coarray != GFC_FCOARRAY_LIB)
|
||||
return NULL_TREE;
|
||||
|
||||
if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
|
||||
{
|
||||
gfc_init_se (&se, NULL);
|
||||
gfc_start_block (&se.pre);
|
||||
|
||||
if (code->expr1 && code->expr1->rank == 0)
|
||||
{
|
||||
gfc_init_se (&argse, NULL);
|
||||
gfc_conv_expr_val (&argse, code->expr1);
|
||||
images = argse.expr;
|
||||
}
|
||||
|
||||
if (code->expr2)
|
||||
{
|
||||
gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
|
||||
gfc_init_se (&argse, NULL);
|
||||
gfc_conv_expr_val (&argse, code->expr2);
|
||||
stat = argse.expr;
|
||||
}
|
||||
|
||||
if (code->expr3 && gfc_option.coarray == GFC_FCOARRAY_LIB
|
||||
&& type != EXEC_SYNC_MEMORY)
|
||||
{
|
||||
gcc_assert (code->expr3->expr_type == EXPR_VARIABLE);
|
||||
gfc_init_se (&argse, NULL);
|
||||
gfc_conv_expr (&argse, code->expr3);
|
||||
gfc_conv_string_parameter (&argse);
|
||||
errmsg = argse.expr;
|
||||
errmsglen = argse.string_length;
|
||||
}
|
||||
else if (gfc_option.coarray == GFC_FCOARRAY_LIB && type != EXEC_SYNC_MEMORY)
|
||||
{
|
||||
errmsg = null_pointer_node;
|
||||
errmsglen = build_int_cst (integer_type_node, 0);
|
||||
}
|
||||
|
||||
/* Check SYNC IMAGES(imageset) for valid image index.
|
||||
|
@ -649,27 +706,100 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type __attribute__ ((unused)))
|
|||
&& code->expr1->rank == 0)
|
||||
{
|
||||
tree cond;
|
||||
gfc_conv_expr (&se, code->expr1);
|
||||
if (gfc_option.coarray != GFC_FCOARRAY_LIB)
|
||||
cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
|
||||
se.expr, build_int_cst (TREE_TYPE (se.expr), 1));
|
||||
images, build_int_cst (TREE_TYPE (images), 1));
|
||||
else
|
||||
{
|
||||
tree cond2;
|
||||
cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
|
||||
images, gfort_gvar_caf_num_images);
|
||||
cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
images,
|
||||
build_int_cst (TREE_TYPE (images), 1));
|
||||
cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
|
||||
boolean_type_node, cond, cond2);
|
||||
}
|
||||
gfc_trans_runtime_check (true, false, cond, &se.pre,
|
||||
&code->expr1->where, "Invalid image number "
|
||||
"%d in SYNC IMAGES",
|
||||
fold_convert (integer_type_node, se.expr));
|
||||
}
|
||||
|
||||
/* If STAT is present, set it to zero. */
|
||||
if (code->expr2)
|
||||
/* Per F2008, 8.5.1, a SYNC MEMORY is implied by calling the
|
||||
image control statements SYNC IMAGES and SYNC ALL. */
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
|
||||
{
|
||||
gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
|
||||
gfc_conv_expr (&se, code->expr2);
|
||||
gfc_add_modify (&se.pre, se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
|
||||
tmp = built_in_decls [BUILT_IN_SYNCHRONIZE];
|
||||
tmp = build_call_expr_loc (input_location, tmp, 0);
|
||||
gfc_add_expr_to_block (&se.pre, tmp);
|
||||
}
|
||||
|
||||
if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
|
||||
return gfc_finish_block (&se.pre);
|
||||
if (gfc_option.coarray != GFC_FCOARRAY_LIB || type == EXEC_SYNC_MEMORY)
|
||||
{
|
||||
/* Set STAT to zero. */
|
||||
if (code->expr2)
|
||||
gfc_add_modify (&se.pre, stat, build_int_cst (TREE_TYPE (stat), 0));
|
||||
}
|
||||
else if (type == EXEC_SYNC_ALL)
|
||||
{
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
|
||||
2, errmsg, errmsglen);
|
||||
if (code->expr2)
|
||||
gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp));
|
||||
else
|
||||
gfc_add_expr_to_block (&se.pre, tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
tree len;
|
||||
|
||||
return NULL_TREE;
|
||||
gcc_assert (type == EXEC_SYNC_IMAGES);
|
||||
|
||||
if (!code->expr1)
|
||||
{
|
||||
len = build_int_cst (integer_type_node, -1);
|
||||
images = null_pointer_node;
|
||||
}
|
||||
else if (code->expr1->rank == 0)
|
||||
{
|
||||
len = build_int_cst (integer_type_node, 1);
|
||||
images = gfc_build_addr_expr (NULL_TREE, images);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* FIXME. */
|
||||
if (code->expr1->ts.kind != gfc_c_int_kind)
|
||||
gfc_fatal_error ("Sorry, only support for integer kind %d "
|
||||
"implemented for image-set at %L",
|
||||
gfc_c_int_kind, &code->expr1->where);
|
||||
|
||||
gfc_conv_array_parameter (&se, code->expr1,
|
||||
gfc_walk_expr (code->expr1), true, NULL,
|
||||
NULL, &len);
|
||||
images = se.expr;
|
||||
|
||||
tmp = gfc_typenode_for_spec (&code->expr1->ts);
|
||||
if (GFC_ARRAY_TYPE_P (tmp) || GFC_DESCRIPTOR_TYPE_P (tmp))
|
||||
tmp = gfc_get_element_type (tmp);
|
||||
|
||||
len = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
|
||||
TREE_TYPE (len), len,
|
||||
fold_convert (TREE_TYPE (len),
|
||||
TYPE_SIZE_UNIT (tmp)));
|
||||
len = fold_convert (integer_type_node, len);
|
||||
}
|
||||
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, 4,
|
||||
fold_convert (integer_type_node, len), images,
|
||||
errmsg, errmsglen);
|
||||
if (code->expr2)
|
||||
gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp));
|
||||
else
|
||||
gfc_add_expr_to_block (&se.pre, tmp);
|
||||
}
|
||||
|
||||
return gfc_finish_block (&se.pre);
|
||||
}
|
||||
|
||||
|
||||
|
@ -870,9 +1000,24 @@ gfc_trans_critical (gfc_code *code)
|
|||
tree tmp;
|
||||
|
||||
gfc_start_block (&block);
|
||||
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
|
||||
{
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_critical, 0);
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
}
|
||||
|
||||
tmp = gfc_trans_code (code->block->next);
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
|
||||
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
|
||||
{
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_end_critical,
|
||||
0);
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
}
|
||||
|
||||
|
||||
return gfc_finish_block (&block);
|
||||
}
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
/* Header for code translation functions
|
||||
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
|
||||
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
|
||||
Free Software Foundation, Inc.
|
||||
Contributed by Paul Brook
|
||||
|
||||
|
@ -452,6 +452,9 @@ bool gfc_get_module_backend_decl (gfc_symbol *);
|
|||
/* Return the variable decl for a symbol. */
|
||||
tree gfc_get_symbol_decl (gfc_symbol *);
|
||||
|
||||
/* Initialize coarray global variables. */
|
||||
void gfc_init_coarray_decl (void);
|
||||
|
||||
/* Build a static initializer. */
|
||||
tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool);
|
||||
|
||||
|
@ -613,6 +616,22 @@ extern GTY(()) tree gfor_fndecl_in_pack;
|
|||
extern GTY(()) tree gfor_fndecl_in_unpack;
|
||||
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_critical;
|
||||
extern GTY(()) tree gfor_fndecl_caf_end_critical;
|
||||
extern GTY(()) tree gfor_fndecl_caf_sync_all;
|
||||
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. */
|
||||
|
||||
|
|
Loading…
Reference in New Issue