Patchwork [Fortran,4.7] PR 18918 - Add initial support for a coarray communication library

login
register
mail settings
Submitter Tobias Burnus
Date March 19, 2011, 4:23 p.m.
Message ID <4D84D875.9010501@net-b.de>
Download mbox | patch
Permalink /patch/87612/
State New
Headers show

Comments

Tobias Burnus - March 19, 2011, 4:23 p.m.
This patch adds a first support for a coarray communication library.

Note: The patch does not yet allow communication (i.e. access to remote 
coarrays); thus it is only of limited practical use. (If you restrict 
yourself to barriers and this_image/num_images, you can already 
parallelize.)

This patch contains two parts: (a) The front end part, which mainly adds 
some library calls. (b) Two communication library implementations. 
(Single-image library and a very initial MPI version.)


To (a): The patch adds library calls for
- Initialization and finalization
- STOP/ERROR STOP
- SYNC ALL/SYNC IMAGES
- CRITICAL block
- num_images() and this_image()*
- Additionally, SYNC MEMORY is handled (via BUILT_IN_SYNCHRONIZE)
(* only no-argument version)


To (b): The MPI library currently requires MPI 2.x, does not work for 
SYNC IMAGE(<images>), and is very rough.

The single-image library version is the library equivalent to 
-fcoarray=single, but less efficient. Its purpose is for testing - and 
to avoid recompilation (e.g. if you do not have the source code).

My idea is to place those library into libgfortran/caf. The user has to 
compile them themselves and link it then to their "gfortran 
-fcoarray=lib" compiled program. (Cf. 
http://gcc.gnu.org/ml/fortran/2011-03/msg00003.html).

Build and regtested on x86-64-linux.
(a) Is the patch OK for the 4.7 trunk?
(b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and 
libgfortrancaf_single.c OK for inclusion at libgfortran/caf?

  * * *

TODO:
- Documentation about the usage of coarrays - and in particular calling 
the library for programs with a non-gfortran main program
- Add test-suite support, where the user specifies (e.g. via environment 
variables?) the to-be-linked coarray communication library (e.g. 
"-lgfortrancaf_mpi") and the command to run it (e.g. "mpiexec -n 3")
- autoconf work: Allow to automatically build the communication library 
(statically), in particular the single-image version.

And the obvious extensions:
- Implement ATOMIC, LOCK, coarray registration/communication, and other 
left overs
- Properly implement an MPI version.

(I plan to concentrate on the front-end (FE) version - and will only do 
a minimal version for the single/MPI library. I hope that someone else 
will take over that part. If not, I might do it after the FE part is 
implemented. Maybe, one also finds a student, who wants to work on it 
via Google's Summer of Code program.)

Tobias
Steve Kargl - March 19, 2011, 5:26 p.m.
On Sat, Mar 19, 2011 at 05:23:17PM +0100, Tobias Burnus wrote:
> 
> My idea is to place those library into libgfortran/caf. The user has to 
> compile them themselves and link it then to their "gfortran 
> -fcoarray=lib" compiled program. (Cf. 
> http://gcc.gnu.org/ml/fortran/2011-03/msg00003.html).

See below at [1].
 
> Build and regtested on x86-64-linux.
> (a) Is the patch OK for the 4.7 trunk?
> (b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and 
> libgfortrancaf_single.c OK for inclusion at libgfortran/caf?
> 

Just a comment on names.  Since you are planning to install
these in libgfortran/caf, please shorten the file names to
caf.h, caf_mpi.c, and caf_single.c.  Consider this a friendly
RSI prevention measure.

[1] I don't understand what you mean by the above.  Are you saying that
gcc would install caf.h, caf_mpi.c, etc in say
lib/gcc/i386-unknown-freebsd9.0/4.7.0/libgfortran
and a user would need to do

gfortran -fcoarray=mpi file.f90 ${PATH}/lib/gcc/i386-unknown-freebsd9.0/4.7.0/libgfortran/caf_mpi.c

to compile her code to use coarrays?
Tobias Burnus - March 19, 2011, 6 p.m.
Steve Kargl wrote:
> On Sat, Mar 19, 2011 at 05:23:17PM +0100, Tobias Burnus wrote:
>> My idea is to place those library into libgfortran/caf. The user has to
>> compile them themselves and link it then to their "gfortran
>> -fcoarray=lib" compiled program. (Cf.
>> http://gcc.gnu.org/ml/fortran/2011-03/msg00003.html).
> [1] I don't understand what you mean by the above.  Are you saying that
> gcc would install caf.h, caf_mpi.c, etc in say
> lib/gcc/i386-unknown-freebsd9.0/4.7.0/libgfortran
> and a user would need to do
>
> gfortran -fcoarray=mpi file.f90 ${PATH}/lib/gcc/i386-unknown-freebsd9.0/4.7.0/libgfortran/caf_mpi.c
>
> to compile her code to use coarrays?

Well, the code is only in the GCC source code and not in the installed 
directory (as in your example); and the -fcoarray= argument is "lib" and 
not "mpi".

But the answer is: Essentially, yes. One has the same issue as with 
gfortran's -fexternal-blas and with GCC's -mveclibabi=<acml|svml>. 
Namely, there is a lot of system dependency. For BLAS there exists 
Netlib's and several vendor versions and also for ACML/SVML on might 
have different file names and library paths.

While the single-image library version could be directly compiled and 
linked, that's not possible with MPI. There exist too many MPI 
implementations and too much system dependence to do this automatically.

Thus, the procedure is usually the following; one compiles the file once 
- for real deployment, one would do something like the following (e.g. 
as HPC administrator or as Linux distributor):

mpicc -O2 -flto -c $GCC_SOURCE/libgfortran/caf/libgfortrancaf_mpi.c
ar rcs libgfortrancaf_mpi.a libgfortrancaf_mpi.o
cp libgfortrancaf_mpi.a  /usr/lib64/mpi/gcc/openmpi/lib64

(As a user with self-compiled gfortran, one would copy it, e.g., to 
$HOME/gcc-trunk/lib{,64}.)


And when compiling a coarray program, one simply specifies the library as in

mpif90 -fcoarray=lib *.f90 -lgfortrancaf_mpi


In the future, one could automatically generate the single-image library 
and - when passing some MPI-settings to ./configure - also a version for 
MPI, which would then be installed in, e.g., 
$prefix/lib64/gcc/x86_64-gnu-linux/4.7/. [1]

(For the shared-memory version [-fcoarray=shared] one will automatically 
link the library, but first the library implementation has to work, 
before one starts another construction site. The advantage for the 
shared-library version is that one has a known ABI for libpthread - and 
might be able to share some of the existing libgomp functions.)

If you have a better idea how one should handle the MPI-wrapper library, 
I would be interested. (Besides, I am looking for a full review of 
either the library or of the front-end patch ;-)

  * * *

>> >  (b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and
>> >  libgfortrancaf_single.c OK for inclusion at libgfortran/caf?
> Just a comment on names.  Since you are planning to install
> these in libgfortran/caf, please shorten the file names to
> caf.h, caf_mpi.c, and caf_single.c.  Consider this a friendly
> RSI prevention measure.

I was thinking of using the lib- prefix for linking as one should at the 
end generate a lib*.a file (cf. libgfortran.h). And I feared that 
libcaf.* might be ambiguous, if one places into $prefix/lib/. But I am 
fine with libcaf.h or with caf.h if you think that it is preferable.

Tobias

[1] Cf. Ralf's comments at 
http://gcc.gnu.org/ml/fortran/2011-03/msg00004.html
Ralf Wildenhues - March 19, 2011, 7:24 p.m.
Hi Tobias,

> void
> _gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
> {
>   int flag;
> 
>   /* The following is only the case if one does not have a Fortran
>      main program. */
>   MPI_Initialized (&flag);
>   if (!flag)
>     MPI_Init (argc, argv);
[...]
> }
> 
> 
> /* Finalize coarray program. Note: This is only called before the
>    program ends; thus the MPI_Initialized status of _gfortran_caf_init
>    does not play a role.  */
> 
> void
> _gfortran_caf_finalize (void)
> {
>   MPI_Win_free (&caf_world_window);
>   MPI_Finalize ();
> }

Some MPI implementations require that the thread that called MPI_Init
also calls MPI_Finalize.  How can this be ensured in this case?
(Sure is something that can be fixed later, but maybe it is not relevant
for this?)

Thanks,
Ralf
Tobias Burnus - March 19, 2011, 9:08 p.m.
Hi Ralf,

Ralf Wildenhues wrote:
> Some MPI implementations require that the thread that called MPI_Init
> also calls MPI_Finalize.  How can this be ensured in this case?

Well, the front-end only calls (via the wrapper) MPI_Finalize for STOP 
and at the end of the main program. However, the end of the main program 
cannot be present if the main program is not in Fortran - and if the 
main program is written in Fortran, it will be MPI_Init. And in case of 
STOP, if the program exits, there is no chance to leave invoke 
MPI_Finalize of the original thread. (STOP is the normal termination, 
ERROR STOP is the error termination.) Thus, I think the code is OK.

Thanks for scrutinizing at the code.

Tobias
Tobias Burnus - March 24, 2011, 3:54 p.m.
*ping*

http://gcc.gnu.org/ml/fortran/2011-03/msg00162.html
(RFC patch: http://gcc.gnu.org/ml/fortran/2011-03/msg00003.html)

Tobias

PS: I will come back to the other emails of this week tomorrow; I am 
still recovering from a cold, which started with fever last Sunday :-(

On 19.03.2011 17:23, Tobias Burnus wrote:
> Build and regtested on x86-64-linux.
> (a) Is the patch OK for the 4.7 trunk?
> (b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and 
> libgfortrancaf_single.c OK for inclusion at libgfortran/caf?
Tobias Burnus - March 26, 2011, 11:49 a.m.
ping**2

On 24.03.2011 16:54, Tobias Burnus wrote:
> *ping*
>
> http://gcc.gnu.org/ml/fortran/2011-03/msg00162.html
> (RFC patch: http://gcc.gnu.org/ml/fortran/2011-03/msg00003.html)
>
> Tobias
>
> PS: I will come back to the other emails of this week tomorrow; I am 
> still recovering from a cold, which started with fever last Sunday :-(
>
> On 19.03.2011 17:23, Tobias Burnus wrote:
>> Build and regtested on x86-64-linux.
>> (a) Is the patch OK for the 4.7 trunk?
>> (b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and 
>> libgfortrancaf_single.c OK for inclusion at libgfortran/caf?
>
>
Jerry DeLisle - March 26, 2011, 3:56 p.m.
On 03/26/2011 04:49 AM, Tobias Burnus wrote:
> ping**2
>
> On 24.03.2011 16:54, Tobias Burnus wrote:
>> *ping*
>>
>> http://gcc.gnu.org/ml/fortran/2011-03/msg00162.html
>> (RFC patch: http://gcc.gnu.org/ml/fortran/2011-03/msg00003.html)
>>
>> Tobias
>>
>> PS: I will come back to the other emails of this week tomorrow; I am still
>> recovering from a cold, which started with fever last Sunday :-(
>>
>> On 19.03.2011 17:23, Tobias Burnus wrote:
>>> Build and regtested on x86-64-linux.
>>> (a) Is the patch OK for the 4.7 trunk?

OK

>>> (b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and
>>> libgfortrancaf_single.c OK for inclusion at libgfortran/caf?
>>

I like the idea of segregating this into a subdirectory. This will help keep 
things isolated.

So OK by me.

Jerry
Tobias Burnus - March 27, 2011, 9:58 a.m.
On 26.03.2011 16:56, Jerry DeLisle wrote:
>>> On 19.03.2011 17:23, Tobias Burnus wrote:
>>>> Build and regtested on x86-64-linux.
>>>> (a) Is the patch OK for the 4.7 trunk?
> OK

Committed as Rev. 171568.

>>>> (b) Are the libgfortrancaf.h, libgfortrancaf_mpi.c and
>>>> libgfortrancaf_single.c OK for inclusion at libgfortran/caf?
>>>
> I like the idea of segregating this into a subdirectory. This will 
> help keep things isolated.
> So OK by me.

Committed as Rev. 171570. I followed Steve's suggestion to rename the 
files to something shorter. I now use: libcaf.h, mpi.c, single.c.

The usage of the coarray library is now described at 
http://gcc.gnu.org/wiki/CoarrayLib

  * * *

The next step is to fill the gaps to make the coarray support really 
useful. As written before: The coarray support is very limited and as of 
now communication for coarrays themselves are supported, which limits 
the current support to programs which do not need any cross-image 
communication ;-)

Tobias

Patch

2011-03-19  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.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b64fa20..9a6907e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 80dbaa8..0fea078 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -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,
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 22245c9..f226039 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -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
 
 
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index d8309d2..5042db3 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -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)
 {
-  resolve_bound (f, array, dim, NULL, "__this_image", true);
+  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;
+    }
 }
 
 
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 85a73d8..09524d0 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -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;
 
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index c116103..656cbca 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -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
 
@@ -515,6 +515,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);
 }
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index bb8b575..69edad8 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -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;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 08207e0..a0bbe53 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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),
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 403aa30..fa3e4c2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -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:
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 98fb74c..2d43627 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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;
 
-  if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
+  /* 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; 
+
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  if (code->expr1 && code->expr1->rank == 0)
     {
-      gfc_init_se (&se, NULL);
-      gfc_start_block (&se.pre);
+      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);
-      cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-			      se.expr, build_int_cst (TREE_TYPE (se.expr), 1));
+      if (gfc_option.coarray != GFC_FCOARRAY_LIB)
+	cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				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)
+     {
+	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 (gfc_option.coarray != GFC_FCOARRAY_LIB || type == EXEC_SYNC_MEMORY)
     {
-      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));
+      /* 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;
+
+      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);
     }
 
-  if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
-    return gfc_finish_block (&se.pre);
- 
-  return NULL_TREE;
+  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);
 }
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1536f2e..19e86bb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -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.  */