This is the patch recently discussed in the GFortran list, now ready for
official submission.
As my first submission as a GSoC student, this is a simple patch mainly
intended to familiarize me with GFortran. I changed the signature of the
functions _gfortran_caf_sync_all and _gfortran_caf_sync_images so that
the "stat" (status) is a function parameter. For example:
==============
BEFORE:
void *
_gfortran_caf_sync_all (char *errmsg, int errmsg_len)
==============
AFTER:
void
_gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len)
--------------
This will be necessary to implement SYNC ALL and SYNC IMAGES correctly.
In the process I also fixed a couple other issues: The parameters
"errmsg" and "images" (caf_sync_images) were not passed correctly.
Attached is my patch, along with the corresponding test cases, which is
destined for gcc/testsuite/gfortran.dg/coarray. Lastly, here is my
ChangeLog:
=================== ./gcc/fortran/ChangeLog ===================
2011-06-07 Daniel Carrera <dcarr...@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/ChangeLog ===================
2011-06-07 Daniel Carrera <dcarr...@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/ChangeLog ===================
2011-06-07 Daniel Carrera <dcarr...@gmail.com>
* gfortran.dg/coarray/sync_1.f90: New
Test "SYNC ALL", "SYNC MEMORY" and "SYNC IMAGES".
--
I'm not overweight, I'm undertall.
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 174722)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -683,6 +683,8 @@
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_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 @@
}
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 @@
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);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 174722)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -3059,13 +3059,13 @@
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")),
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c (revision 174722)
+++ libgfortran/caf/single.c (working copy)
@@ -69,16 +69,19 @@
}
-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 @@
}
#endif
- return 0;
+ if (stat)
+ *stat = 0;
}
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h (revision 174722)
+++ libgfortran/caf/libcaf.h (working copy)
@@ -54,8 +54,8 @@
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. */
Index: libgfortran/caf/mpi.c
===================================================================
--- libgfortran/caf/mpi.c (revision 174722)
+++ libgfortran/caf/mpi.c (working copy)
@@ -92,42 +92,50 @@
}
-/* 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
{
int i;
@@ -151,20 +159,28 @@
}
/* 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;
}
! { dg-do run }
! { dg-shouldfail "error stop" }
!
! 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
