]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
gfortran.h (gfc_init_coarray_decl): Remove.
authorTobias Burnus <burnus@net-b.de>
Wed, 30 Apr 2014 19:02:23 +0000 (21:02 +0200)
committerTobias Burnus <burnus@gcc.gnu.org>
Wed, 30 Apr 2014 19:02:23 +0000 (21:02 +0200)
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

15 files changed:
gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/parse.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans-stmt.c
gcc/fortran/trans-types.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/caf/libcaf.h
libgfortran/caf/mpi.c
libgfortran/caf/single.c

index 356bb485d1555ce79c18885f53802c506ce63ec6..3502f489f22eaa0dafa142cc1b28bd6e65b80e75 100644 (file)
@@ -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
index f0eed809ab8a4e32f5be47c9247db5193d520d0a..0707b58bd2b62d54dc27a98af86b484f12cbf71c 100644 (file)
@@ -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 *);
index 0faf47a00412e01103ae64377e81067dca955f7c..77667150176216ad0ee4fe2a0475bf6dfcd27a21 100644 (file)
@@ -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,
-                            bool main_in_tu)
+translate_all_program_units (gfc_namespace *gfc_global_ns_list)
 {
   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;
index cf7b661d8e97898df9615ffea911810e73d23e44..c835a3b34de3ead91ee4039d03d470ea24284eb5 100644 (file)
@@ -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, 4,
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 2,
                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_build_addr_expr (pppchar_type, argv));
       gfc_add_expr_to_block (&body, tmp);
     }
 
index 070b64ed97503f2a00ae7ea3e0c9bd0ff1628c2a..e13c0dedd11917f583f6ddc2d309e8d8d2c045e6 100644 (file)
@@ -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 = fold_build2_loc (input_location, MINUS_EXPR, type, tmp,
-                      build_int_cst (type, 1));
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+                            integer_zero_node);
+  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);
-      num_images = fold_convert (type, gfort_gvar_caf_num_images);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+                                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);
-  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
-                          gfort_gvar_caf_num_images);
+  tree tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+                                 integer_zero_node,
+                                 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,
-                                              gfort_gvar_caf_num_images),
+                                fold_convert (gfc_array_index_type, tmp),
                                 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,
-                                              gfort_gvar_caf_num_images),
+                                fold_convert (gfc_array_index_type, tmp),
                                 build_int_cst (gfc_array_index_type, 1));
          resbound = fold_build2_loc (input_location, PLUS_EXPR,
                                      gfc_array_index_type, resbound, tmp);
index 00c99fcfb5beacdc871e35c559505c55659726b6..212a2586d2acae0e0f1fd98b2ae67a5f861750ed 100644 (file)
@@ -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));
index 243feb7aedbc74674ec735dc547eb80f3a5b1e45..f69371288a90333260e8250fd44cfc5518f06144 100644 (file)
@@ -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);
 }
 \f
index f8d29ecf2ec4767d90df56307838843208dcf2dc..13b0a0005442138960541374d0a3d41a59d512d4 100644 (file)
@@ -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.  */
index d1955b4eb05d71de964224f531591f42bcf0439f..74791d9155b1bd8f6d81862c8a46af7de30556e7 100644 (file)
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90
new file mode 100644 (file)
index 0000000..fe56516
--- /dev/null
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
new file mode 100644 (file)
index 0000000..9219b2a
--- /dev/null
@@ -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" } }
index dc37a861f024eaa8456af1290239717fa6e4d44c..e78a498c7f681fb56e199a3f26003d1f6d6e7c63 100644 (file)
@@ -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
index 7ecd76fcecb1e200e15a4aa712aa8e038a48a3d1..8b8fd3e2b8f5e8a0b28b22c6cc37242f8ae7d0a4 100644 (file)
@@ -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 *,
-                              char *, int);
-void _gfortran_caf_deregister (void ***, int *, char *, int);
+int _gfortran_caf_this_image (int);
+int _gfortran_caf_num_images (int, bool);
 
+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);
index da7185ed09fef6e6d3062d7a7638b6293962e2a7..fe2baf4633caa4b981e814dccd9e41acc101298c 100644 (file)
@@ -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 (caf_static_list->token);
+      free (TOKEN (caf_static_list->token)[caf_this_image-1]);
+      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);
 }
 
index 551b9aa784dd1ac27cf48a0d9c0e3785535f0a8e..cf1ced85d907e47bcba3a89ac3b01bb36687aa30 100644 (file)
@@ -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)),
-                   int *this_image, int *num_images)
+                   char ***argv __attribute__ ((unused)))
 {
-  *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)[0] = local;
+  *token = malloc (sizeof (single_token_t));
 
   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);
+  free (TOKEN(*token));
 
   if (stat)
     *stat = 0;