gfortran.h (gfc_init_coarray_decl): Remove.

2014-04-30  Tobias Burnus  <burnus@net-b.de>

        * gfortran.h (gfc_init_coarray_decl): Remove.
        * parse.c (translate_all_program_units): Remove call to it.
        (gfc_parse_file): Update call.
        * trans.h (gfor_fndecl_caf_this_image,
        gfor_fndecl_caf_num_images): Add.
        (gfort_gvar_caf_num_images,
        gfort_gvar_caf_this_image): Remove.
        * trans-decl.c (gfor_fndecl_caf_this_image,
        gfor_fndecl_caf_num_images): Add.
        (gfort_gvar_caf_num_images,
        gfort_gvar_caf_this_image): Remove.
        (gfc_build_builtin_function_decls): Init new decl.
        (gfc_init_coarray_dec): Remove.
        (create_main_function): Change calls.
        * trans-intrinsic.c (trans_this_image, trans_image_index,
        conv_intrinsic_cobound): Generate call to new library function
        instead of to a static variable.
        * trans-stmt.c (gfc_trans_sync): Ditto.

2014-04-30  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_lib_this_image_1.f90: New.
        * gfortran.dg/coarray_lib_this_image_2.f90: New.

2014-04-30  Tobias Burnus  <burnus@net-b.de>

        * caf/libcaf.h (_gfortran_caf_this_image,
        * _gfortran_caf_num_images):
        New prototypes.
        (_gfortran_caf_init): Change prototype.
        (mpi_token_t): New typedef.
        (TOKEN): New define.
        * caf/mpi.c (_gfortran_caf_this_image,
        * _gfortran_caf_num_images):
        New functions.
        (_gfortran_caf_init): Update.
        (_gfortran_caf_finalize, _gfortran_caf_register,
        _gfortran_caf_deregister): Use mpi_token_t.
        * caf/single.c (_gfortran_caf_this_image,
        * _gfortran_caf_num_images):
        New functions.
        (_gfortran_caf_init): Update.
        (_gfortran_caf_finalize, _gfortran_caf_register,
        _gfortran_caf_deregister): Use mpi_token_t, simplify.

From-SVN: r209951

gcc/fortran/ChangeLog

@@ -1,3 +1,24 @@
+2014-04-30  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h (gfc_init_coarray_decl): Remove.
+	* parse.c (translate_all_program_units): Remove call to it.
+	(gfc_parse_file): Update call.
+	* trans.h (gfor_fndecl_caf_this_image,
+	gfor_fndecl_caf_num_images): Add.
+	(gfort_gvar_caf_num_images,
+	gfort_gvar_caf_this_image): Remove.
+	* trans-decl.c (gfor_fndecl_caf_this_image,
+	gfor_fndecl_caf_num_images): Add.
+	(gfort_gvar_caf_num_images,
+	gfort_gvar_caf_this_image): Remove.
+	(gfc_build_builtin_function_decls): Init new decl.
+	(gfc_init_coarray_dec): Remove.
+	(create_main_function): Change calls.
+	* trans-intrinsic.c (trans_this_image, trans_image_index,
+	conv_intrinsic_cobound): Generate call to new library function
+	instead of to a static variable.
+	* trans-stmt.c (gfc_trans_sync): Ditto.
+
 2014-04-30  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-expr.c (get_tree_for_caf_expr): Fix handling of polymorphic

gcc/fortran/gfortran.h

@@ -2948,7 +2948,6 @@ bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
 /* trans.c */
 void gfc_generate_code (gfc_namespace *);
 void gfc_generate_module_code (gfc_namespace *);
-void gfc_init_coarray_decl (bool);
 
 /* trans-intrinsic.c */
 bool gfc_inline_intrinsic_function_p (gfc_expr *);

gcc/fortran/parse.c

@@ -4495,19 +4495,13 @@ clean_up_modules (gfc_gsymbol *gsym)
 /* Translate all the program units. This could be in a different order
    to resolution if there are forward references in the file.  */
 static void
-translate_all_program_units (gfc_namespace *gfc_global_ns_list,
+translate_all_program_units (gfc_namespace *gfc_global_ns_list)
-			     bool main_in_tu)
 {
   int errors;
 
   gfc_current_ns = gfc_global_ns_list;
   gfc_get_errors (NULL, &errors);
 
-  /* If the main program is in the translation unit and we have
-     -fcoarray=libs, generate the static variables.  */
-  if (gfc_option.coarray == GFC_FCOARRAY_LIB && main_in_tu)
-    gfc_init_coarray_decl (true);
-
   /* We first translate all modules to make sure that later parts
      of the program can use the decl. Then we translate the nonmodules.  */
 
@@ -4729,7 +4723,7 @@ prog_units:
       }
 
   /* Do the translation.  */
-  translate_all_program_units (gfc_global_ns_list, seen_program);
+  translate_all_program_units (gfc_global_ns_list);
 
   gfc_end_source_files ();
   return true;

gcc/fortran/trans-decl.c

@@ -121,6 +121,8 @@ tree gfor_fndecl_associated;
 /* Coarray run-time library function decls.  */
 tree gfor_fndecl_caf_init;
 tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_this_image;
+tree gfor_fndecl_caf_num_images;
 tree gfor_fndecl_caf_register;
 tree gfor_fndecl_caf_deregister;
 tree gfor_fndecl_caf_critical;
@@ -130,11 +132,6 @@ 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.  */
@@ -3247,6 +3244,14 @@ gfc_build_builtin_function_decls (void)
       gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
 
+      gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
+		   get_identifier (PREFIX("caf_this_image")), integer_type_node,
+		   1, integer_type_node);
+
+      gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
+		   get_identifier (PREFIX("caf_num_images")), integer_type_node,
+		   2, integer_type_node, boolean_type_node);
+
       gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
         size_type_node, integer_type_node, ppvoid_type_node, pint_type,
@@ -5105,59 +5110,6 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
 }
 
 
-/* Generate the _gfortran_caf_this_image and _gfortran_caf_num_images
-   global variables for -fcoarray=lib. They are placed into the translation
-   unit of the main program.  Make sure that in one TU (the one of the main
-   program), the first call to gfc_init_coarray_decl is done with true.
-   Otherwise, expect link errors.  */
-
-void
-gfc_init_coarray_decl (bool main_tu)
-{
-  if (gfc_option.coarray != GFC_FCOARRAY_LIB)
-    return;
-
-  if (gfort_gvar_caf_this_image || gfort_gvar_caf_num_images)
-    return;
-
-  push_cfun (cfun);
-
-  gfort_gvar_caf_this_image
-	= build_decl (input_location, VAR_DECL,
-		      get_identifier (PREFIX("caf_this_image")),
-		      integer_type_node);
-  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_READONLY (gfort_gvar_caf_this_image) = 0;
-
-  if (main_tu)
-    TREE_STATIC (gfort_gvar_caf_this_image) = 1;
-  else
-    DECL_EXTERNAL (gfort_gvar_caf_this_image) = 1;
-
-  pushdecl_top_level (gfort_gvar_caf_this_image);
-
-  gfort_gvar_caf_num_images
-	= build_decl (input_location, VAR_DECL,
-		      get_identifier (PREFIX("caf_num_images")),
-		      integer_type_node);
-  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_READONLY (gfort_gvar_caf_num_images) = 0;
-
-  if (main_tu)
-    TREE_STATIC (gfort_gvar_caf_num_images) = 1;
-  else
-    DECL_EXTERNAL (gfort_gvar_caf_num_images) = 1;
-
-  pushdecl_top_level (gfort_gvar_caf_num_images);
-
-  pop_cfun ();
-}
-
-
 static void
 create_main_function (tree fndecl)
 {
@@ -5237,7 +5189,7 @@ create_main_function (tree fndecl)
 
   /* Call some libgfortran initialization routines, call then MAIN__(). */
 
-  /* Call _gfortran_caf_init (*argc, ***argv, *this_image, *num_images).  */
+  /* Call _gfortran_caf_init (*argc, ***argv).  */
   if (gfc_option.coarray == GFC_FCOARRAY_LIB)
     {
       tree pint_type, pppchar_type;
@@ -5245,12 +5197,9 @@ create_main_function (tree fndecl)
       pppchar_type
 	= build_pointer_type (build_pointer_type (pchar_type_node));
 
-      gfc_init_coarray_decl (true);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 2,
-      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 (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);
     }
 

gcc/fortran/trans-intrinsic.c

@@ -937,13 +937,13 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   /* The case -fcoarray=single is handled elsewhere.  */
   gcc_assert (gfc_option.coarray != GFC_FCOARRAY_SINGLE);
 
-  gfc_init_coarray_decl (false);
-
   /* Argument-free version: THIS_IMAGE().  */
   if (expr->value.function.actual->expr == NULL)
     {
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+				 integer_zero_node);
       se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
-			       gfort_gvar_caf_this_image);
+			       tmp);
       return;
     }
 
@@ -1039,9 +1039,10 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   */
 
   /* this_image () - 1.  */
-  tmp = fold_convert (type, gfort_gvar_caf_this_image);
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
-  tmp = fold_build2_loc (input_location, MINUS_EXPR, type, tmp,
+			     integer_zero_node);
-		       build_int_cst (type, 1));
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, type,
+			 fold_convert (type, tmp), build_int_cst (type, 1));
   if (corank == 1)
     {
       /* sub(1) = m + lcobound(corank).  */
@@ -1244,8 +1245,10 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
     num_images = build_int_cst (type, 1);
   else
     {
-      gfc_init_coarray_decl (false);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
-      num_images = fold_convert (type, gfort_gvar_caf_num_images);
+				 integer_zero_node,
+				 build_int_cst (integer_type_node, -1));
+      num_images = fold_convert (type, tmp);
     }
 
   tmp = gfc_create_var (type, NULL);
@@ -1264,9 +1267,10 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
 static void
 trans_num_images (gfc_se * se)
 {
-  gfc_init_coarray_decl (false);
+  tree tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
-  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
+				  integer_zero_node,
-			   gfort_gvar_caf_num_images);
+				  build_int_cst (integer_type_node, -1));
+  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
 }
 
 
@@ -1607,13 +1611,13 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
 	{
           tree cosize;
 
-	  gfc_init_coarray_decl (false);
 	  cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
-
+	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+				     2, integer_zero_node,
+				     build_int_cst (integer_type_node, -1));
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				 gfc_array_index_type,
-				 fold_convert (gfc_array_index_type,
+				 fold_convert (gfc_array_index_type, tmp),
-					       gfort_gvar_caf_num_images),
 				 build_int_cst (gfc_array_index_type, 1));
 	  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
 				 gfc_array_index_type, tmp,
@@ -1624,11 +1628,12 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
       else if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
 	{
 	  /* ubound = lbound + num_images() - 1.  */
-	  gfc_init_coarray_decl (false);
+	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+				     2, integer_zero_node,
+				     build_int_cst (integer_type_node, -1));
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				 gfc_array_index_type,
-				 fold_convert (gfc_array_index_type,
+				 fold_convert (gfc_array_index_type, tmp),
-					       gfort_gvar_caf_num_images),
 				 build_int_cst (gfc_array_index_type, 1));
 	  resbound = fold_build2_loc (input_location, PLUS_EXPR,
 				      gfc_array_index_type, resbound, tmp);

gcc/fortran/trans-stmt.c

@@ -784,8 +784,11 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
       else
 	{
 	  tree cond2;
+	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+				     2, integer_zero_node,
+				     build_int_cst (integer_type_node, -1));
 	  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
-				  images, gfort_gvar_caf_num_images);
+				  images, tmp);
 	  cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
 				   images,
 				   build_int_cst (TREE_TYPE (images), 1));

gcc/fortran/trans-types.c

@@ -1303,7 +1303,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
 {
   tree lbound[GFC_MAX_DIMENSIONS];
   tree ubound[GFC_MAX_DIMENSIONS];
-  int n;
+  int n, corank;
+
+  /* Assumed-shape arrays do not have codimension information stored in the
+     descriptor.  */
+  corank = as->corank;
+  if (as->type == AS_ASSUMED_SHAPE ||
+      (as->type == AS_ASSUMED_RANK && akind == GFC_ARRAY_ALLOCATABLE))
+    corank = 0;
 
   if (as->type == AS_ASSUMED_RANK)
     for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
@@ -1322,14 +1329,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
       ubound[n] = gfc_conv_array_bound (as->upper[n]);
     }
 
-  for (n = as->rank; n < as->rank + as->corank; n++)
+  for (n = as->rank; n < as->rank + corank; n++)
     {
       if (as->type != AS_DEFERRED && as->lower[n] == NULL)
         lbound[n] = gfc_index_one_node;
       else
         lbound[n] = gfc_conv_array_bound (as->lower[n]);
 
-      if (n < as->rank + as->corank - 1)
+      if (n < as->rank + corank - 1)
 	ubound[n] = gfc_conv_array_bound (as->upper[n]);
     }
 
@@ -1341,7 +1348,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
 		       : GFC_ARRAY_ASSUMED_RANK;
   return gfc_get_array_type_bounds (type, as->rank == -1
 					  ? GFC_MAX_DIMENSIONS : as->rank,
-				    as->corank, lbound,
+				    corank, lbound,
 				    ubound, 0, akind, restricted);
 }
 

gcc/fortran/trans.h

@@ -699,6 +699,8 @@ 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_this_image;
+extern GTY(()) tree gfor_fndecl_caf_num_images;
 extern GTY(()) tree gfor_fndecl_caf_register;
 extern GTY(()) tree gfor_fndecl_caf_deregister;
 extern GTY(()) tree gfor_fndecl_caf_critical;
@@ -708,10 +710,6 @@ 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.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2014-04-30  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.dg/coarray_lib_this_image_1.f90: New.
+	* gfortran.dg/coarray_lib_this_image_2.f90: New.
+
 2014-04-30  Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.dg/coarray_poly_4.f90: New.

gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90

@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+
+  implicit none
+  real :: x(2)[*]
+  call bar(x)
+contains
+  subroutine bar(x)
+    integer :: mylcobound, myucobound, mylbound, mythis_image
+    real :: x(2)[5:*]
+    mylcobound = lcobound(x,dim=1)
+    myucobound = ucobound(x,dim=1)
+    mylbound = lbound(x,dim=1)
+    mythis_image = this_image()
+  end subroutine bar
+end
+
+! { dg-final { scan-tree-dump-times "bar \\(real\\(kind=4\\)\\\[2\\\] \\* restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
+! { dg.final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(x, caf_token.., 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90

@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+
+  implicit none
+  real :: x(2)[*]
+  call bar(x)
+contains
+  subroutine bar(x)
+    integer :: mylcobound, myucobound, mylbound, mythis_image
+    real :: x(:)[5:*]
+    mylcobound = lcobound(x,dim=1)
+    myucobound = ucobound(x,dim=1)
+    mylbound = lbound(x,dim=1)
+    mythis_image = this_image()
+  end subroutine bar
+end
+
+! { dg-final { scan-tree-dump-times "bar \\(struct array2_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylbound = parm...dim\\\[0\\\].stride >= 0 && parm...dim\\\[0\\\].ubound >= parm...dim\\\[0\\\].lbound \\|\\| parm...dim\\\[0\\\].stride < 0 \\? \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound : 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=8\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=8\\)\\) x\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

libgfortran/ChangeLog

@@ -1,3 +1,21 @@
+2014-04-30  Tobias Burnus  <burnus@net-b.de>
+
+	* caf/libcaf.h (_gfortran_caf_this_image, _gfortran_caf_num_images):
+	New prototypes.
+	(_gfortran_caf_init): Change prototype.
+	(mpi_token_t): New typedef.
+	(TOKEN): New define.
+	* caf/mpi.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
+	New functions.
+	(_gfortran_caf_init): Update.
+	(_gfortran_caf_finalize, _gfortran_caf_register,
+	_gfortran_caf_deregister): Use mpi_token_t.
+	* caf/single.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
+	New functions.
+	(_gfortran_caf_init): Update.
+	(_gfortran_caf_finalize, _gfortran_caf_register,
+	_gfortran_caf_deregister): Use mpi_token_t, simplify.
+
 2014-04-26  Jerry DeLisle  <jvdelisle@gcc.gnu>
 
 	PR libfortran/52539

libgfortran/caf/libcaf.h

@@ -26,8 +26,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #ifndef LIBCAF_H
 #define LIBCAF_H
 
+#include <stdbool.h>
+#include <stddef.h>	/* For size_t.  */
 #include <stdint.h>	/* For int32_t.  */
-#include <stddef.h>	/* For ptrdiff_t.  */
 
 #ifndef __GNUC__
 #define __attribute__(x)
@@ -55,21 +56,25 @@ typedef enum caf_register_t {
 }
 caf_register_t;
 
+typedef void* caf_token_t;
+
 /* Linked list of static coarrays registered.  */
 typedef struct caf_static_t {
-  void **token;
+  caf_token_t token;
   struct caf_static_t *prev;
 }
 caf_static_t;
 
 
-void _gfortran_caf_init (int *, char ***, int *, int *);
+void _gfortran_caf_init (int *, char ***);
 void _gfortran_caf_finalize (void);
 
-void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void ***, int *,
+int _gfortran_caf_this_image (int);
-			       char *, int);
+int _gfortran_caf_num_images (int, bool);
-void _gfortran_caf_deregister (void ***, int *, char *, int);
 
+void *_gfortran_caf_register (size_t, caf_register_t, caf_token_t *, int *,
+			      char *, int);
+void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
 
 void _gfortran_caf_sync_all (int *, char *, int);
 void _gfortran_caf_sync_images (int, int[], int *, char *, int);

libgfortran/caf/mpi.c

@@ -34,6 +34,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 /* Define GFC_CAF_CHECK to enable run-time checking.  */
 /* #define GFC_CAF_CHECK  1  */
 
+typedef void ** mpi_token_t;
+#define TOKEN(X) ((mpi_token_t) (X))
 
 static void error_stop (int error) __attribute__ ((noreturn));
 
@@ -73,7 +75,7 @@ caf_runtime_error (const char *message, ...)
    libaray is initialized.  */
 
 void
-_gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
+_gfortran_caf_init (int *argc, char ***argv)
 {
   if (caf_num_images == 0)
     {
@@ -87,11 +89,6 @@ _gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
       MPI_Comm_rank (MPI_COMM_WORLD, &caf_this_image);
       caf_this_image++;
     }
-
-  if (this_image)
-    *this_image = caf_this_image;
-  if (num_images)
-    *num_images = caf_num_images;
 }
 
 
@@ -104,8 +101,8 @@ _gfortran_caf_finalize (void)
     {
       caf_static_t *tmp = caf_static_list->prev;
 
-      free (caf_static_list->token[caf_this_image-1]);
+      free (TOKEN (caf_static_list->token)[caf_this_image-1]);
-      free (caf_static_list->token);
+      free (TOKEN (caf_static_list->token));
       free (caf_static_list);
       caf_static_list = tmp;
     }
@@ -117,8 +114,23 @@ _gfortran_caf_finalize (void)
 }
 
 
+int
+_gfortran_caf_this_image (int distance __attribute__ ((unused)))
+{
+  return caf_this_image;
+}
+
+
+int
+_gfortran_caf_num_images (int distance __attribute__ ((unused)),
+			  bool failed __attribute__ ((unused)))
+{
+  return caf_num_images;
+}
+
+
 void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
+_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
 			int *stat, char *errmsg, int errmsg_len)
 {
   void *local;
@@ -129,17 +141,17 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
 
   /* Start MPI if not already started.  */
   if (caf_num_images == 0)
-    _gfortran_caf_init (NULL, NULL, NULL, NULL);
+    _gfortran_caf_init (NULL, NULL);
 
   /* Token contains only a list of pointers.  */
   local = malloc (size);
-  *token = malloc (sizeof (void*) * caf_num_images);
+  *token = malloc (sizeof (mpi_token_t) * caf_num_images);
 
   if (unlikely (local == NULL || *token == NULL))
     goto error;
 
   /* token[img-1] is the address of the token in image "img".  */
-  err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, *token,
+  err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, TOKEN (*token),
 		       sizeof (void*), MPI_BYTE, MPI_COMM_WORLD);
 
   if (unlikely (err))
@@ -192,7 +204,7 @@ error:
 
 
 void
-_gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len)
+_gfortran_caf_deregister (caf_token_t *token, int *stat, char *errmsg, int errmsg_len)
 {
   if (unlikely (caf_is_finalized))
     {
@@ -220,7 +232,7 @@ _gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len
   if (stat)
     *stat = 0;
 
-  free ((*token)[caf_this_image-1]);
+  free (TOKEN (*token)[caf_this_image-1]);
   free (*token);
 }
 

libgfortran/caf/single.c

@@ -32,6 +32,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 /* Define GFC_CAF_CHECK to enable run-time checking.  */
 /* #define GFC_CAF_CHECK  1  */
 
+typedef void* single_token_t;
+#define TOKEN(X) ((single_token_t) (X))
+
 /* Single-image implementation of the CAF library.
    Note: For performance reasons -fcoarry=single should be used
    rather than this library.  */
@@ -57,11 +60,8 @@ caf_runtime_error (const char *message, ...)
 
 void
 _gfortran_caf_init (int *argc __attribute__ ((unused)),
-		    char ***argv __attribute__ ((unused)),
+		    char ***argv __attribute__ ((unused)))
-		    int *this_image, int *num_images)
 {
-  *this_image = 1;
-  *num_images = 1;
 }
 
 
@@ -71,7 +71,6 @@ _gfortran_caf_finalize (void)
   while (caf_static_list != NULL)
     {
       caf_static_t *tmp = caf_static_list->prev;
-      free (caf_static_list->token[0]);
       free (caf_static_list->token);
       free (caf_static_list);
       caf_static_list = tmp;
@@ -79,15 +78,29 @@ _gfortran_caf_finalize (void)
 }
 
 
+int
+_gfortran_caf_this_image (int distance __attribute__ ((unused)))
+{
+  return 1;
+}
+
+
+int
+_gfortran_caf_num_images (int distance __attribute__ ((unused)),
+			  bool failed __attribute__ ((unused)))
+{
+  return 1;
+}
+
+
 void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
+_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
 			int *stat, char *errmsg, int errmsg_len)
 {
   void *local;
 
   local = malloc (size);
-  *token = malloc (sizeof (void*) * 1);
+  *token = malloc (sizeof (single_token_t));
-  (*token)[0] = local;
 
   if (unlikely (local == NULL || token == NULL))
     {
@@ -109,6 +122,8 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
 	  caf_runtime_error (msg);
     }
 
+  *token = local;
+
   if (stat)
     *stat = 0;
 
@@ -124,12 +139,11 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
 
 
 void
-_gfortran_caf_deregister (void ***token, int *stat,
+_gfortran_caf_deregister (caf_token_t *token, int *stat,
 			  char *errmsg __attribute__ ((unused)),
 			  int errmsg_len __attribute__ ((unused)))
 {
-  free ((*token)[0]);
+  free (TOKEN(*token));
-  free (*token);
 
   if (stat)
     *stat = 0;