OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

trans-decl.c (gfc_build_builtin_function_decls): Updated declaration of caf_sync_all and caf_sync_images. 

gcc/fortran/
2011-06-10  Daniel Carrera  <dcarrera@gmail.com>

        * trans-decl.c (gfc_build_builtin_function_decls):
        Updated declaration of caf_sync_all and caf_sync_images.
        * trans-stmt.c (gfc_trans_sync): Function
        can now handle a "stat" variable that has an integer type
        different from integer_type_node.

libgfortran/
2011-06-10  Daniel Carrera  <dcarrera@gmail.com>

        * caf/mpi.c (_gfortran_caf_sync_all,
        _gfortran_caf_sync_images): Functions have void return type
        and move status into parameter list.
        * caf/single.c (_gfortran_caf_sync_all,
        _gfortran_caf_sync_images): Functions have void return type
        and move status into parameter list.
        * caf/libcaf.h (_gfortran_caf_sync_all,
        _gfortran_caf_sync_images): Functions have void return type
        and move status into parameter list.

gcc/testsuite/
2011-06-10  Daniel Carrera  <dcarrera@gmail.com>

        * gfortran.dg/coarray/sync_1.f90: New test for
        "SYNC ALL", "SYNC MEMORY" and "SYNC IMAGES".

From-SVN: r174896
This commit is contained in:
Daniel Carrera 2011-06-10 12:22:24 +02:00 committed by Tobias Burnus
parent fede8efad0
commit f5c01f5bde
9 changed files with 215 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2011-06-10 Daniel Carrera <dcarrera@gmail.com>
* trans-decl.c (gfc_build_builtin_function_decls):
Updated declaration of caf_sync_all and caf_sync_images.
* trans-stmt.c (gfc_trans_sync): Function
can now handle a "stat" variable that has an integer type
different from integer_type_node.
2011-06-09 Richard Guenther <rguenther@suse.de>
* trans.c (gfc_allocate_array_with_status): Mark error path

10
gcc/fortran/trans-decl.c
View File

@ -3059,13 +3059,13 @@ gfc_build_builtin_function_decls (void)
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);
get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
3, pint_type, 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);
get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
5, integer_type_node, pint_type, 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")),

67
gcc/fortran/trans-stmt.c
View File

@ -683,6 +683,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
gfc_conv_expr_val (&argse, code->expr2);
stat = argse.expr;
}
else
stat = null_pointer_node;
if (code->expr3 && gfc_option.coarray == GFC_FCOARRAY_LIB
&& type != EXEC_SYNC_MEMORY)
@ -691,7 +693,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
gfc_init_se (&argse, NULL);
gfc_conv_expr (&argse, code->expr3);
gfc_conv_string_parameter (&argse);
errmsg = argse.expr;
errmsg = gfc_build_addr_expr (NULL, argse.expr);
errmsglen = argse.string_length;
}
else if (gfc_option.coarray == GFC_FCOARRAY_LIB && type != EXEC_SYNC_MEMORY)
@ -743,12 +745,32 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
}
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));
/* SYNC ALL => stat == null_pointer_node
SYNC ALL(stat=s) => stat has an integer type
If "stat" has the wrong integer type, use a temp variable of
the right type and later cast the result back into "stat". */
if (stat == null_pointer_node || TREE_TYPE (stat) == integer_type_node)
{
if (TREE_TYPE (stat) == integer_type_node)
stat = gfc_build_addr_expr (NULL, stat);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
3, stat, errmsg, errmsglen);
gfc_add_expr_to_block (&se.pre, tmp);
}
else
gfc_add_expr_to_block (&se.pre, tmp);
{
tree tmp_stat = gfc_create_var (integer_type_node, "stat");
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
3, gfc_build_addr_expr (NULL, tmp_stat),
errmsg, errmsglen);
gfc_add_expr_to_block (&se.pre, tmp);
gfc_add_modify (&se.pre, stat,
fold_convert (TREE_TYPE (stat), tmp_stat));
}
}
else
{
@ -790,13 +812,34 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
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));
/* SYNC IMAGES(imgs) => stat == null_pointer_node
SYNC IMAGES(imgs,stat=s) => stat has an integer type
If "stat" has the wrong integer type, use a temp variable of
the right type and later cast the result back into "stat". */
if (stat == null_pointer_node || TREE_TYPE (stat) == integer_type_node)
{
if (TREE_TYPE (stat) == integer_type_node)
stat = gfc_build_addr_expr (NULL, stat);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images,
5, fold_convert (integer_type_node, len),
images, stat, errmsg, errmsglen);
gfc_add_expr_to_block (&se.pre, tmp);
}
else
gfc_add_expr_to_block (&se.pre, tmp);
{
tree tmp_stat = gfc_create_var (integer_type_node, "stat");
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images,
5, fold_convert (integer_type_node, len),
images, gfc_build_addr_expr (NULL, tmp_stat),
errmsg, errmsglen);
gfc_add_expr_to_block (&se.pre, tmp);
gfc_add_modify (&se.pre, stat,
fold_convert (TREE_TYPE (stat), tmp_stat));
}
}
return gfc_finish_block (&se.pre);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-06-10 Daniel Carrera <dcarrera@gmail.com>
* gfortran.dg/coarray/sync_1.f90: New test for
"SYNC ALL", "SYNC MEMORY" and "SYNC IMAGES".
2011-06-10 Ira Rosen <ira.rosen@linaro.org>
PR tree-optimization/49318

64
gcc/testsuite/gfortran.dg/coarray/sync_1.f90 Normal file
View File

@ -0,0 +1,64 @@
! { dg-do run }
!
! Coarray support
! PR fortran/18918
implicit none
integer :: n
character(len=30) :: str
critical
end critical
myCr: critical
end critical myCr
!
! Test SYNC ALL
!
sync all
sync all ( )
sync all (errmsg=str)
n = 5
sync all (stat=n)
if (n /= 0) call abort()
n = 5
sync all (stat=n,errmsg=str)
if (n /= 0) call abort()
!
! Test SYNC MEMORY
!
sync memory
sync memory ( )
sync memory (errmsg=str)
n = 5
sync memory (stat=n)
if (n /= 0) call abort()
n = 5
sync memory (errmsg=str,stat=n)
if (n /= 0) call abort()
!
! Test SYNC IMAGES
!
sync images (*)
if (this_image() == 1) then
sync images (1)
sync images (1, errmsg=str)
sync images ([1])
end if
n = 5
sync images (*, stat=n)
if (n /= 0) call abort()
n = 5
sync images (*,errmsg=str,stat=n)
if (n /= 0) call abort()
end

30
libgfortran/ChangeLog
View File

@ -1,3 +1,15 @@
2011-06-10 Daniel Carrera <dcarrera@gmail.com>
* caf/mpi.c (_gfortran_caf_sync_all,
_gfortran_caf_sync_images): Functions have void return type
and move status into parameter list.
* caf/single.c (_gfortran_caf_sync_all,
_gfortran_caf_sync_images): Functions have void return type
and move status into parameter list.
* caf/libcaf.h (_gfortran_caf_sync_all,
_gfortran_caf_sync_images): Functions have void return type
and move status into parameter list.
2011-06-03 Richard Henderson <rth@redhat.com>
Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
@ -7,15 +19,15 @@
2011-05-29 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/48931
* libgfortran.h (find_addr2line): New prototype.
* runtime/backtrace.c (show_backtrace): Use async-signal-safe
execve and stored path of addr2line.
* runtime/compile_options.c (maybe_find_addr2line): New function.
(set_options): Call maybe_find_addr2line if backtracing is enabled.
* runtime/main.c (find_addr2line): New function.
(init): Call find_addr2line if backtracing is enabled.
(cleanup): Free addr2line_path.
PR libfortran/48931
* libgfortran.h (find_addr2line): New prototype.
* runtime/backtrace.c (show_backtrace): Use async-signal-safe
execve and stored path of addr2line.
* runtime/compile_options.c (maybe_find_addr2line): New function.
(set_options): Call maybe_find_addr2line if backtracing is enabled.
* runtime/main.c (find_addr2line): New function.
(init): Call find_addr2line if backtracing is enabled.
(cleanup): Free addr2line_path.
2011-05-29 Janne Blomqvist <jb@gcc.gnu.org>

4
libgfortran/caf/libcaf.h
View File

@ -54,8 +54,8 @@ void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void **);
int _gfortran_caf_deregister (void **);
int _gfortran_caf_sync_all (char *, int);
int _gfortran_caf_sync_images (int, int[], char *, int);
void _gfortran_caf_sync_all (int *, char *, int);
void _gfortran_caf_sync_images (int, int[], int *, char *, int);
/* FIXME: The CRITICAL functions should be removed;
the functionality is better represented using Coarray's lock feature. */

76
libgfortran/caf/mpi.c
View File

@ -92,41 +92,49 @@ _gfortran_caf_deregister (void **token __attribute__ ((unused)))
}
/* SYNC ALL - the return value matches Fortran's STAT argument. */
int
_gfortran_caf_sync_all (char *errmsg, int errmsg_len)
void
_gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len)
{
int ierr;
ierr = MPI_Barrier (MPI_COMM_WORLD);
/* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */
int ierr = MPI_Barrier (MPI_COMM_WORLD);
if (ierr && errmsg_len > 0)
if (stat)
*stat = ierr;
if (ierr)
{
const char msg[] = "SYNC ALL failed";
int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
: (int) sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
if (errmsg_len > 0)
{
int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
: (int) sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
else
{
fprintf (stderr, "SYNC ALL failed\n");
error_stop (ierr);
}
}
/* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */
return ierr;
}
/* SYNC IMAGES. Note: SYNC IMAGES(*) is passed as count == -1 while
SYNC IMAGES([]) has count == 0. Note further that SYNC IMAGES(*)
is not equivalent to SYNC ALL. The return value matches Fortran's
STAT argument. */
int
_gfortran_caf_sync_images (int count, int images[], char *errmsg,
is not equivalent to SYNC ALL. */
void
_gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
int errmsg_len)
{
int ierr;
if (count == 0 || (count == 1 && images[0] == caf_this_image))
return 0;
{
if (stat)
*stat = 0;
return;
}
#ifdef GFC_CAF_CHECK
{
@ -151,20 +159,28 @@ _gfortran_caf_sync_images (int count, int images[], char *errmsg,
}
/* Handle SYNC IMAGES(*). */
/* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */
ierr = MPI_Barrier (MPI_COMM_WORLD);
if (stat)
*stat = ierr;
if (ierr && errmsg_len > 0)
if (ierr)
{
const char msg[] = "SYNC IMAGES failed";
int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
: (int) sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
if (errmsg_len > 0)
{
int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
: (int) sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
else
{
fprintf (stderr, "SYNC IMAGES failed\n");
error_stop (ierr);
}
}
/* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */
return ierr;
}

14
libgfortran/caf/single.c
View File

@ -69,16 +69,19 @@ _gfortran_caf_deregister (void **token __attribute__ ((unused)))
}
int
_gfortran_caf_sync_all (char *errmsg __attribute__ ((unused)),
void
_gfortran_caf_sync_all (int *stat,
char *errmsg __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused)))
{
return 0;
if (stat)
*stat = 0;
}
int
void
_gfortran_caf_sync_images (int count __attribute__ ((unused)),
int images[] __attribute__ ((unused)),
int *stat,
char *errmsg __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused)))
{
@ -94,7 +97,8 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
}
#endif
return 0;
if (stat)
*stat = 0;
}