+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
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")),
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)
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)
}
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
{
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);
+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
--- /dev/null
+! { 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
+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>
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>
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. */
}
-/* 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 (stat)
+ *stat = ierr;
- if (ierr && errmsg_len > 0)
+ 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
{
}
/* 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;
}
}
-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)))
{
}
#endif
- return 0;
+ if (stat)
+ *stat = 0;
}
projects / gcc.git / commitdiff