[Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 2821 bytes --]

The following applies to -fcoarray=lib; for -fcoarray=single there 
should be no change.

The coarray communication library needs to know about the coarrays even 
before the function containing them has been invoked. Thus, the coarrays 
(of all translation units) need to be registered at start up.

This patch handles this by creating a _caf_init function with 
constructor attribute, which is nested in the the parent's procedure if 
the latter contains local nonallocatable (and thus: static/SAVE) 
coarrays variables.

At the same time, all (nonallocatable) coarrays have been turned into 
pointers - to allow the communication library to allocate the memory. 
This allows optimizations, e.g., by allocating in memory which is 
available for all images on the same node (cf. MPI_Alloc_mem).

Additionally, a "token" is saved with the coarray, which allows the 
coarray library to identify the coarray. In a simple implementation, it 
could simply use the base_addr of the coarray or enumerate them through.


Example: The small example program

------------- < test.f90 >-----------------
program caf_program
   integer :: a[*] = 7
   a = 8
end program caf_program
------------- </ test.f90 >-----------------

is turned into the following tree (-fdump-tree-original)

------------- < test.f90.003t.original >-----------------
_caf_init.1 ()
{
   a = (integer(kind=4) * restrict) _gfortran_caf_register (4, 0, 
&caf_token.0, 0B, 0B, 0);
   *a = 7;
}

caf_program ()
{
   static void * caf_token.0;
   static integer(kind=4) * restrict a;
   void _caf_init.1 (void);

   (integer(kind=4)) *a = 8;
}

main (integer(kind=4) argc, character(kind=1) * * argv)
{
   static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};

   _gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image, 
&_gfortran_caf_num_images);
   _gfortran_set_args (argc, argv);
   _gfortran_set_options (8, &options.2[0]);
   _gfortran_caf_sync_all (0B, 0);
   caf_program ();
   __sync_synchronize ();
   _gfortran_caf_finalize ();
   return 0;
}
------------- </ test.f90.003t.original >-----------------

Note: By construction, _gfortran_caf_register is called before 
_gfortran_caf_init; thus, the MPI library will be initialized by the 
first _gfortran_caf_register call, unless the program does not have any 
nonallocatable coarrays.

No test cases, but the ones in gfortran.dg/coarray/ should already test 
this functionality.

To be done in later patches:
- Coarrays declared in modules (module variables)
- Allocatable coarrays

Note: As constructors are never optimized away [unless they are 
pure/const], static coarrays and also uncalled functions containing 
static coarrays will not be optimized away. (Cf. PRs middle-end/49106 
and middle-end/49108.)

Bootstrapped and regtested on x86-64-linux.
OK for the trunk?

Tobias

[-- Attachment #2: caf_register.diff --]
[-- Type: text/x-patch, Size: 13104 bytes --]

2011-05-22  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* trans-array.c (gfc_conv_array_ref): Handle pointer coarrays.
	* trans-decl.c (has_coarray_vars, caf_init_block,
	gfor_fndecl_caf_register): New file-global variables.
	(gfc_finish_var_decl): Make sure that coarrays in main are static.
	(gfc_build_qualified_array): Generate coarray token variable.
	(gfc_get_symbol_decl): Don't use a static initializer for coarrays.
	(gfc_build_builtin_function_decls): Set gfor_fndecl_caf_register.
	(gfc_trans_deferred_vars, gfc_emit_parameter_debug_info): Skip for
	static coarrays.
	(generate_local_decl): Check for local coarrays.
	(create_main_function): SYNC ALL before calling MAIN.
	(generate_coarray_sym_init): Register static coarray.
	(generate_coarray_init): Generate CAF registering constructor
	function.
	(gfc_generate_function_code): Call it, if needed, do not create
	cgraph twice.
	* trans-types.c (gfc_get_nodesc_array_type): Generate pointers for
	-fcoarray=lib.
	* trans.h (gfor_fndecl_caf_register): New variable.
	(lang_type): New element caf_token.
	(GFC_TYPE_ARRAY_CAF_TOKEN): New macro.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 78d65a6..29c7f83 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2623,6 +2623,10 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   if (ar->dimen == 0)
     {
       gcc_assert (ar->codimen);
+      if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
+	  && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
+	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+
       /* Use the actual tree type and not the wrapped coarray. */
       se->expr = fold_convert (TREE_TYPE (TREE_TYPE (se->expr)), se->expr);
       return;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d771484..5121a39 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -78,6 +78,12 @@ static gfc_namespace *module_namespace;
 static gfc_symbol* current_procedure_symbol = NULL;
 
 
+/* With -fcoarray=lib: For generating the registering call
+   of static coarrays.  */
+static bool has_coarray_vars;
+static stmtblock_t caf_init_block;
+
+
 /* List of static constructor functions.  */
 
 tree gfc_static_ctors;
@@ -114,6 +120,7 @@ tree gfor_fndecl_associated;
 /* Coarray run-time library function decls.  */
 tree gfor_fndecl_caf_init;
 tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_register;
 tree gfor_fndecl_caf_critical;
 tree gfor_fndecl_caf_end_critical;
 tree gfor_fndecl_caf_sync_all;
@@ -566,7 +573,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      SAVE_EXPLICIT.  */
   if (!sym->attr.use_assoc
 	&& (sym->attr.save != SAVE_NONE || sym->attr.data
-	      || (sym->value && sym->ns->proc_name->attr.is_main_program)))
+	    || (sym->value && sym->ns->proc_name->attr.is_main_program)
+	    || (gfc_option.coarray == GFC_FCOARRAY_LIB
+		&& sym->attr.codimension && !sym->attr.allocatable)))
     TREE_STATIC (decl) = 1;
 
   if (sym->attr.volatile_)
@@ -745,6 +754,18 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
   nest = (procns->proc_name->backend_decl != current_function_decl)
 	 && !sym->attr.contained;
 
+  if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB
+      && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE)
+    {
+      tree token;
+
+      token = gfc_create_var_np (pvoid_type_node, "caf_token");
+      GFC_TYPE_ARRAY_CAF_TOKEN (type) = token;
+      DECL_ARTIFICIAL (token) = 1;
+      TREE_STATIC (token) = 1;
+      gfc_add_decl_to_function (token);
+    }
+
   for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++)
     {
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
@@ -1403,7 +1424,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       && !(sym->attr.use_assoc && !intrinsic_array_parameter)
       && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
 	  || gfc_option.flag_max_stack_var_size == 0
-	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
+	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
+      && (gfc_option.coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension))
     {
       /* Add static initializer. For procedures, it is only needed if
 	 SAVE is specified otherwise they need to be reinitialized
@@ -3025,6 +3047,11 @@ 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_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,
+        build_pointer_type (pchar_type_node), integer_type_node);
+
       gfor_fndecl_caf_critical = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_critical")), void_type_node, 0);
 
@@ -3458,7 +3485,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		      gfc_trans_deferred_array (sym, block);
 		    }
 		}
-	      else
+	      else if (gfc_option.coarray != GFC_FCOARRAY_LIB)
 		{
 		  gfc_save_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
@@ -4066,6 +4093,9 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
 				   sym->attr.dimension, false))
     return;
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+    return;
+
   /* Create the decl for the variable or constant.  */
   decl = build_decl (input_location,
 		     sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL,
@@ -4200,6 +4230,10 @@ generate_local_decl (gfc_symbol * sym)
 {
   if (sym->attr.flavor == FL_VARIABLE)
     {
+      if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+	  && sym->attr.referenced)
+	has_coarray_vars = true;
+
       if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master)
 	generate_dependency_declarations (sym);
 
@@ -4826,6 +4860,116 @@ gfc_generate_return (void)
 }
 
 
+static void
+generate_coarray_sym_init (gfc_symbol *sym)
+{
+  tree tmp, size, decl, token;
+
+  if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension)
+    return;
+
+  if (!sym->attr.referenced)
+    return;
+
+  decl = sym->backend_decl;
+  TREE_USED(decl) = 1;
+  gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
+
+  /* FIXME: Workaround for PR middle-end/49106, cf. also PR middle-end/49108
+     to make sure the variable is not optimized away.  */
+  DECL_PRESERVE_P (DECL_CONTEXT (decl)) = 1;
+
+  size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
+
+  if (GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)))
+    {
+      tmp = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (decl));
+      size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			      fold_convert (size_type_node, tmp),
+			      fold_convert (size_type_node, size));
+    }
+
+  gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (decl)) != NULL_TREE);
+  token = gfc_build_addr_expr (ppvoid_type_node,
+			       GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl)));
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
+			     build_int_cst (integer_type_node, 0), /* type.  */
+			     token, null_pointer_node, /* token, stat.  */
+			     null_pointer_node, /* errgmsg, errmsg_len.  */
+			     build_int_cst (integer_type_node, 0));
+  
+  gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
+
+
+  /* Handle "static" initializer.  */
+  if (sym->value)
+    {
+      sym->attr.pointer = 1;
+      tmp = gfc_trans_assignment (gfc_lval_expr_from_sym (sym), sym->value,
+				  true, false);
+      sym->attr.pointer = 0;
+      gfc_add_expr_to_block (&caf_init_block, tmp);
+    }
+}
+
+
+/* Generate constructor function to initialize static, nonallocatable
+   coarrays.  */
+
+static void
+generate_coarray_init (gfc_namespace * ns __attribute((unused)))
+{
+  tree fndecl, tmp, decl, save_fn_decl;
+
+  save_fn_decl = current_function_decl;
+  push_function_context ();
+
+  tmp = build_function_type_list (void_type_node, NULL_TREE);
+  fndecl = build_decl (input_location, FUNCTION_DECL,
+		       create_tmp_var_name ("_caf_init"), tmp);
+
+  DECL_STATIC_CONSTRUCTOR (fndecl) = 1;
+  SET_DECL_INIT_PRIORITY (fndecl, DEFAULT_INIT_PRIORITY);
+
+  decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node);
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+  DECL_CONTEXT (decl) = fndecl;
+  DECL_RESULT (fndecl) = decl;
+
+  pushdecl (fndecl);
+  current_function_decl = fndecl;
+  announce_function (fndecl);
+
+  rest_of_decl_compilation (fndecl, 0, 0);
+  make_decl_rtl (fndecl);
+  init_function_start (fndecl);
+
+  pushlevel (0);
+  gfc_init_block (&caf_init_block);
+
+  gfc_traverse_ns (ns, generate_coarray_sym_init);
+
+  DECL_SAVED_TREE (fndecl) = gfc_finish_block (&caf_init_block);
+  decl = getdecls ();
+
+  poplevel (1, 0, 1);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+                DECL_INITIAL (fndecl));
+  dump_function (TDI_original, fndecl);
+
+  cfun->function_end_locus = input_location;
+  set_cfun (NULL);
+  (void) cgraph_create_node (fndecl);
+  pop_function_context ();
+  current_function_decl = save_fn_decl;
+}
+
+
 /* Generate code for a function.  */
 
 void
@@ -4897,8 +5041,12 @@ gfc_generate_function_code (gfc_namespace * ns)
   nonlocal_dummy_decls = NULL;
   nonlocal_dummy_decl_pset = NULL;
 
+  has_coarray_vars = false;
   generate_local_vars (ns);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   /* Keep the parent fake result declaration in module functions
      or external procedures.  */
   if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
@@ -5062,9 +5210,13 @@ gfc_generate_function_code (gfc_namespace * ns)
     }
   current_function_decl = old_context;
 
-  if (decl_function_context (fndecl))
+  if (decl_function_context (fndecl) && !gfc_option.coarray == GFC_FCOARRAY_LIB
+      && has_coarray_vars)
     /* Register this function with cgraph just far enough to get it
-       added to our parent's nested function list.  */
+       added to our parent's nested function list.
+       If there are static coarrays in this function, the nested _caf_init
+       function has already called cgraph_create_node, which also created
+       the cgraph node for this function.  */
     (void) cgraph_create_node (fndecl);
   else
     cgraph_finalize_function (fndecl, true);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1165926..9c4f5f6 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1542,13 +1542,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
 
   if (as->rank == 0)
     {
-      if (packed != PACKED_STATIC)
+      if (packed != PACKED_STATIC  || gfc_option.coarray == GFC_FCOARRAY_LIB)
 	type = build_pointer_type (type);
 
       if (restricted)
         type = build_qualified_type (type, TYPE_QUAL_RESTRICT);	
 
-      if (packed != PACKED_STATIC)
+      if (packed != PACKED_STATIC  || gfc_option.coarray == GFC_FCOARRAY_LIB)
 	{
 	  GFC_ARRAY_TYPE_P (type) = 1;
 	  TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type)); 
@@ -1596,7 +1596,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
       DECL_ORIGINAL_TYPE (type_decl) = gtype;
     }
 
-  if (packed != PACKED_STATIC || !known_stride)
+  if (packed != PACKED_STATIC || !known_stride
+      || (as->corank && gfc_option.coarray == GFC_FCOARRAY_LIB))
     {
       /* For dummy arrays and automatic (heap allocated) arrays we
 	 want a pointer to the array.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2b06d80..95cd9fb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -617,6 +617,7 @@ 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_register;
 extern GTY(()) tree gfor_fndecl_caf_critical;
 extern GTY(()) tree gfor_fndecl_caf_end_critical;
 extern GTY(()) tree gfor_fndecl_caf_sync_all;
@@ -722,6 +723,7 @@ struct GTY((variable_size))	lang_type	 {
   tree span;
   tree base_decl[2];
   tree nonrestricted_type;
+  tree caf_token;
 };
 
 struct GTY((variable_size)) lang_decl {
@@ -766,6 +768,7 @@ struct GTY((variable_size)) lang_decl {
   (TYPE_LANG_SPECIFIC(node)->stride[dim])
 #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
 #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
+#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
 #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
 #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
 #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)

Re: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 3350 bytes --]

Instead of a ping, an updated patch. This one additionally supports 
registering of nonallocatable coarrays also in MODULE and in BLOCK plus 
a test case.

(Changes to gfc_generate_module_vars and gfc_process_block_locals and 
cgraph call in generate_coarray_init; some functions were moved up in 
the trans-decl.c file.)

OK for the trunk?

Tobias

On 22 May 2011, Tobias Burnus wrote:
> The following applies to -fcoarray=lib; for -fcoarray=single there 
> should be no change.
>
> The coarray communication library needs to know about the coarrays 
> even before the function containing them has been invoked. Thus, the 
> coarrays (of all translation units) need to be registered at start up.
>
> This patch handles this by creating a _caf_init function with 
> constructor attribute, which is nested in the the parent's procedure 
> if the latter contains local nonallocatable (and thus: static/SAVE) 
> coarrays variables.
>
> At the same time, all (nonallocatable) coarrays have been turned into 
> pointers - to allow the communication library to allocate the memory. 
> This allows optimizations, e.g., by allocating in memory which is 
> available for all images on the same node (cf. MPI_Alloc_mem).
>
> Additionally, a "token" is saved with the coarray, which allows the 
> coarray library to identify the coarray. In a simple implementation, 
> it could simply use the base_addr of the coarray or enumerate them 
> through.
>
>
> Example: The small example program
>
> ------------- < test.f90 >-----------------
> program caf_program
>   integer :: a[*] = 7
>   a = 8
> end program caf_program
> ------------- </ test.f90 >-----------------
>
> is turned into the following tree (-fdump-tree-original)
>
> ------------- < test.f90.003t.original >-----------------
> _caf_init.1 ()
> {
>   a = (integer(kind=4) * restrict) _gfortran_caf_register (4, 0, 
> &caf_token.0, 0B, 0B, 0);
>   *a = 7;
> }
>
> caf_program ()
> {
>   static void * caf_token.0;
>   static integer(kind=4) * restrict a;
>   void _caf_init.1 (void);
>
>   (integer(kind=4)) *a = 8;
> }
>
> main (integer(kind=4) argc, character(kind=1) * * argv)
> {
>   static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};
>
>   _gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image, 
> &_gfortran_caf_num_images);
>   _gfortran_set_args (argc, argv);
>   _gfortran_set_options (8, &options.2[0]);
>   _gfortran_caf_sync_all (0B, 0);
>   caf_program ();
>   __sync_synchronize ();
>   _gfortran_caf_finalize ();
>   return 0;
> }
> ------------- </ test.f90.003t.original >-----------------
>
> Note: By construction, _gfortran_caf_register is called before 
> _gfortran_caf_init; thus, the MPI library will be initialized by the 
> first _gfortran_caf_register call, unless the program does not have 
> any nonallocatable coarrays.
>
> No test cases, but the ones in gfortran.dg/coarray/ should already 
> test this functionality.
>
> To be done in later patches:
> - Coarrays declared in modules (module variables)
> - Allocatable coarrays
>
> Note: As constructors are never optimized away [unless they are 
> pure/const], static coarrays and also uncalled functions containing 
> static coarrays will not be optimized away. (Cf. PRs middle-end/49106 
> and middle-end/49108.)
>
> Bootstrapped and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias


[-- Attachment #2: caf_register-v2.diff --]
[-- Type: text/x-patch, Size: 15548 bytes --]

2011-05-24  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* trans-array.c (gfc_conv_array_ref): Handle pointer coarrays.
	* trans-decl.c (has_coarray_vars, caf_init_block,
	gfor_fndecl_caf_register): New file-global variables.
	(gfc_finish_var_decl): Make sure that coarrays in main are static.
	(gfc_build_qualified_array): Generate coarray token variable.
	(gfc_get_symbol_decl): Don't use a static initializer for coarrays.
	(gfc_build_builtin_function_decls): Set gfor_fndecl_caf_register.
	(gfc_trans_deferred_vars, gfc_emit_parameter_debug_info): Skip for
	static coarrays.
	(generate_local_decl): Check for local coarrays.
	(create_main_function): SYNC ALL before calling MAIN.
	(generate_coarray_sym_init): Register static coarray.
	(generate_coarray_init): Generate CAF registering constructor
	function.
	(gfc_generate_function_code): Call it, if needed, do not create
	cgraph twice.
	(gfc_generate_module_vars, gfc_process_block_locals): Call
	generate_coarray_init.
	* trans-types.c (gfc_get_nodesc_array_type): Generate pointers for
	-fcoarray=lib.
	* trans.h (gfor_fndecl_caf_register): New variable.
	(lang_type): New element caf_token.
	(GFC_TYPE_ARRAY_CAF_TOKEN): New macro.

2011-05-22  Tobias Burnus  <burnus@net-b.de>

	PR fortran/18918
	* gfortran.dg/coarray/registering_1.f90: New.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 78d65a6..29c7f83 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2623,6 +2623,10 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   if (ar->dimen == 0)
     {
       gcc_assert (ar->codimen);
+      if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
+	  && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
+	se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+
       /* Use the actual tree type and not the wrapped coarray. */
       se->expr = fold_convert (TREE_TYPE (TREE_TYPE (se->expr)), se->expr);
       return;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d771484..299f224 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -78,6 +78,12 @@ static gfc_namespace *module_namespace;
 static gfc_symbol* current_procedure_symbol = NULL;
 
 
+/* With -fcoarray=lib: For generating the registering call
+   of static coarrays.  */
+static bool has_coarray_vars;
+static stmtblock_t caf_init_block;
+
+
 /* List of static constructor functions.  */
 
 tree gfc_static_ctors;
@@ -114,6 +120,7 @@ tree gfor_fndecl_associated;
 /* Coarray run-time library function decls.  */
 tree gfor_fndecl_caf_init;
 tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_register;
 tree gfor_fndecl_caf_critical;
 tree gfor_fndecl_caf_end_critical;
 tree gfor_fndecl_caf_sync_all;
@@ -566,7 +573,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      SAVE_EXPLICIT.  */
   if (!sym->attr.use_assoc
 	&& (sym->attr.save != SAVE_NONE || sym->attr.data
-	      || (sym->value && sym->ns->proc_name->attr.is_main_program)))
+	    || (sym->value && sym->ns->proc_name->attr.is_main_program)
+	    || (gfc_option.coarray == GFC_FCOARRAY_LIB
+		&& sym->attr.codimension && !sym->attr.allocatable)))
     TREE_STATIC (decl) = 1;
 
   if (sym->attr.volatile_)
@@ -745,6 +754,18 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
   nest = (procns->proc_name->backend_decl != current_function_decl)
 	 && !sym->attr.contained;
 
+  if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB
+      && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE)
+    {
+      tree token;
+
+      token = gfc_create_var_np (pvoid_type_node, "caf_token");
+      GFC_TYPE_ARRAY_CAF_TOKEN (type) = token;
+      DECL_ARTIFICIAL (token) = 1;
+      TREE_STATIC (token) = 1;
+      gfc_add_decl_to_function (token);
+    }
+
   for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++)
     {
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
@@ -1403,7 +1424,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       && !(sym->attr.use_assoc && !intrinsic_array_parameter)
       && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
 	  || gfc_option.flag_max_stack_var_size == 0
-	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
+	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
+      && (gfc_option.coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension))
     {
       /* Add static initializer. For procedures, it is only needed if
 	 SAVE is specified otherwise they need to be reinitialized
@@ -3025,6 +3047,11 @@ 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_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,
+        build_pointer_type (pchar_type_node), integer_type_node);
+
       gfor_fndecl_caf_critical = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_critical")), void_type_node, 0);
 
@@ -3458,7 +3485,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		      gfc_trans_deferred_array (sym, block);
 		    }
 		}
-	      else
+	      else if (gfc_option.coarray != GFC_FCOARRAY_LIB)
 		{
 		  gfc_save_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
@@ -3864,6 +3891,10 @@ gfc_create_module_variable (gfc_symbol * sym)
           rest_of_decl_compilation (length, 1, 0);
         }
     }
+
+  if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+      && sym->attr.referenced && !sym->attr.use_assoc)
+    has_coarray_vars = true;
 }
 
 /* Emit debug information for USE statements.  */
@@ -4066,6 +4097,9 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
 				   sym->attr.dimension, false))
     return;
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+    return;
+
   /* Create the decl for the variable or constant.  */
   decl = build_decl (input_location,
 		     sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL,
@@ -4087,6 +4121,120 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
   debug_hooks->global_decl (decl);
 }
 
+
+static void
+generate_coarray_sym_init (gfc_symbol *sym)
+{
+  tree tmp, size, decl, token;
+
+  if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
+      || sym->attr.use_assoc || !sym->attr.referenced) 
+    return;
+
+  decl = sym->backend_decl;
+  TREE_USED(decl) = 1;
+  gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
+
+  /* FIXME: Workaround for PR middle-end/49106, cf. also PR middle-end/49108
+     to make sure the variable is not optimized away.  */
+  DECL_PRESERVE_P (DECL_CONTEXT (decl)) = 1;
+
+  size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
+
+  if (GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)))
+    {
+      tmp = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (decl));
+      size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			      fold_convert (size_type_node, tmp),
+			      fold_convert (size_type_node, size));
+    }
+
+  gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (decl)) != NULL_TREE);
+  token = gfc_build_addr_expr (ppvoid_type_node,
+			       GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl)));
+
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
+			     build_int_cst (integer_type_node, 0), /* type.  */
+			     token, null_pointer_node, /* token, stat.  */
+			     null_pointer_node, /* errgmsg, errmsg_len.  */
+			     build_int_cst (integer_type_node, 0));
+  
+  gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
+
+
+  /* Handle "static" initializer.  */
+  if (sym->value)
+    {
+      sym->attr.pointer = 1;
+      tmp = gfc_trans_assignment (gfc_lval_expr_from_sym (sym), sym->value,
+				  true, false);
+      sym->attr.pointer = 0;
+      gfc_add_expr_to_block (&caf_init_block, tmp);
+    }
+}
+
+
+/* Generate constructor function to initialize static, nonallocatable
+   coarrays.  */
+
+static void
+generate_coarray_init (gfc_namespace * ns __attribute((unused)))
+{
+  tree fndecl, tmp, decl, save_fn_decl;
+
+  save_fn_decl = current_function_decl;
+  push_function_context ();
+
+  tmp = build_function_type_list (void_type_node, NULL_TREE);
+  fndecl = build_decl (input_location, FUNCTION_DECL,
+		       create_tmp_var_name ("_caf_init"), tmp);
+
+  DECL_STATIC_CONSTRUCTOR (fndecl) = 1;
+  SET_DECL_INIT_PRIORITY (fndecl, DEFAULT_INIT_PRIORITY);
+
+  decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node);
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+  DECL_CONTEXT (decl) = fndecl;
+  DECL_RESULT (fndecl) = decl;
+
+  pushdecl (fndecl);
+  current_function_decl = fndecl;
+  announce_function (fndecl);
+
+  rest_of_decl_compilation (fndecl, 0, 0);
+  make_decl_rtl (fndecl);
+  init_function_start (fndecl);
+
+  pushlevel (0);
+  gfc_init_block (&caf_init_block);
+
+  gfc_traverse_ns (ns, generate_coarray_sym_init);
+
+  DECL_SAVED_TREE (fndecl) = gfc_finish_block (&caf_init_block);
+  decl = getdecls ();
+
+  poplevel (1, 0, 1);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+                DECL_INITIAL (fndecl));
+  dump_function (TDI_original, fndecl);
+
+  cfun->function_end_locus = input_location;
+  set_cfun (NULL);
+
+  if (decl_function_context (fndecl))
+    (void) cgraph_create_node (fndecl);
+  else
+    cgraph_finalize_function (fndecl, true);
+
+  pop_function_context ();
+  current_function_decl = save_fn_decl;
+}
+
+
 /* Generate all the required code for module variables.  */
 
 void
@@ -4101,9 +4249,14 @@ gfc_generate_module_vars (gfc_namespace * ns)
   /* Generate COMMON blocks.  */
   gfc_trans_common (ns);
 
+  has_coarray_vars = false;
+
   /* Create decls for all the module variables.  */
   gfc_traverse_ns (ns, gfc_create_module_variable);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   cur_module = NULL;
 
   gfc_trans_use_stmts (ns);
@@ -4200,6 +4353,10 @@ generate_local_decl (gfc_symbol * sym)
 {
   if (sym->attr.flavor == FL_VARIABLE)
     {
+      if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+	  && sym->attr.referenced && !sym->attr.use_assoc)
+	has_coarray_vars = true;
+
       if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master)
 	generate_dependency_declarations (sym);
 
@@ -4897,8 +5054,12 @@ gfc_generate_function_code (gfc_namespace * ns)
   nonlocal_dummy_decls = NULL;
   nonlocal_dummy_decl_pset = NULL;
 
+  has_coarray_vars = false;
   generate_local_vars (ns);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   /* Keep the parent fake result declaration in module functions
      or external procedures.  */
   if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
@@ -5062,9 +5223,13 @@ gfc_generate_function_code (gfc_namespace * ns)
     }
   current_function_decl = old_context;
 
-  if (decl_function_context (fndecl))
+  if (decl_function_context (fndecl) && !gfc_option.coarray == GFC_FCOARRAY_LIB
+      && has_coarray_vars)
     /* Register this function with cgraph just far enough to get it
-       added to our parent's nested function list.  */
+       added to our parent's nested function list.
+       If there are static coarrays in this function, the nested _caf_init
+       function has already called cgraph_create_node, which also created
+       the cgraph node for this function.  */
     (void) cgraph_create_node (fndecl);
   else
     cgraph_finalize_function (fndecl, true);
@@ -5190,8 +5355,13 @@ gfc_process_block_locals (gfc_namespace* ns)
   tree decl;
 
   gcc_assert (saved_local_decls == NULL_TREE);
+  has_coarray_vars = false;
+
   generate_local_vars (ns);
 
+  if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+    generate_coarray_init (ns);
+
   decl = saved_local_decls;
   while (decl)
     {
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1165926..9c4f5f6 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1542,13 +1542,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
 
   if (as->rank == 0)
     {
-      if (packed != PACKED_STATIC)
+      if (packed != PACKED_STATIC  || gfc_option.coarray == GFC_FCOARRAY_LIB)
 	type = build_pointer_type (type);
 
       if (restricted)
         type = build_qualified_type (type, TYPE_QUAL_RESTRICT);	
 
-      if (packed != PACKED_STATIC)
+      if (packed != PACKED_STATIC  || gfc_option.coarray == GFC_FCOARRAY_LIB)
 	{
 	  GFC_ARRAY_TYPE_P (type) = 1;
 	  TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type)); 
@@ -1596,7 +1596,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
       DECL_ORIGINAL_TYPE (type_decl) = gtype;
     }
 
-  if (packed != PACKED_STATIC || !known_stride)
+  if (packed != PACKED_STATIC || !known_stride
+      || (as->corank && gfc_option.coarray == GFC_FCOARRAY_LIB))
     {
       /* For dummy arrays and automatic (heap allocated) arrays we
 	 want a pointer to the array.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2b06d80..95cd9fb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -617,6 +617,7 @@ 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_register;
 extern GTY(()) tree gfor_fndecl_caf_critical;
 extern GTY(()) tree gfor_fndecl_caf_end_critical;
 extern GTY(()) tree gfor_fndecl_caf_sync_all;
@@ -722,6 +723,7 @@ struct GTY((variable_size))	lang_type	 {
   tree span;
   tree base_decl[2];
   tree nonrestricted_type;
+  tree caf_token;
 };
 
 struct GTY((variable_size)) lang_decl {
@@ -766,6 +768,7 @@ struct GTY((variable_size)) lang_decl {
   (TYPE_LANG_SPECIFIC(node)->stride[dim])
 #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
 #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
+#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
 #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
 #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
 #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
--- /dev/null	2011-05-24 21:36:28.023892895 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/registering_1.f90	2011-05-24 23:46:25.000000000 +0200
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR fortran/18918
+!
+! Check whether registering coarrays works
+!
+module m
+  integer :: a(1)[*] = 7
+end module m
+
+use m
+if (any (a /= 7)) call abort()
+a = 88
+if (any (a /= 88)) call abort()
+
+ block
+   integer :: b[*] = 8494
+   if (b /= 8494) call abort()
+ end block
+
+if (any (a /= 88)) call abort()
+call test ()
+end
+
+subroutine test()
+  complex :: z = (1,1)
+  if (z /= (1,1)) call abort()
+  call sub1()
+contains
+  subroutine sub1
+    real :: r = -1
+    if (r /= -1) call abort
+    r = 10
+    if (r /= 10) call abort
+  end subroutine sub1
+
+  subroutine uncalled()
+     integer :: not_refed = 784
+     if (not_refed /= 784) call abort()
+  end subroutine uncalled
+end subroutine test

Re: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Tobias Burnus]

ping**0.3

http://gcc.gnu.org/ml/fortran/2011-05/msg00176.html

Tobias Burnus wrote:
> Instead of a ping, an updated patch. This one additionally supports 
> registering of nonallocatable coarrays also in MODULE and in BLOCK 
> plus a test case.
>
> (Changes to gfc_generate_module_vars and gfc_process_block_locals and 
> cgraph call in generate_coarray_init; some functions were moved up in 
> the trans-decl.c file.)
>
> OK for the trunk?
>
> Tobias
>
> On 22 May 2011, Tobias Burnus wrote:
>> The following applies to -fcoarray=lib; for -fcoarray=single there 
>> should be no change.
>>
>> The coarray communication library needs to know about the coarrays 
>> even before the function containing them has been invoked. Thus, the 
>> coarrays (of all translation units) need to be registered at start up.
>>
>> This patch handles this by creating a _caf_init function with 
>> constructor attribute, which is nested in the the parent's procedure 
>> if the latter contains local nonallocatable (and thus: static/SAVE) 
>> coarrays variables.
>>
>> At the same time, all (nonallocatable) coarrays have been turned into 
>> pointers - to allow the communication library to allocate the memory. 
>> This allows optimizations, e.g., by allocating in memory which is 
>> available for all images on the same node (cf. MPI_Alloc_mem).
>>
>> Additionally, a "token" is saved with the coarray, which allows the 
>> coarray library to identify the coarray. In a simple implementation, 
>> it could simply use the base_addr of the coarray or enumerate them 
>> through.
>>
>>
>> Example: The small example program
>>
>> ------------- < test.f90 >-----------------
>> program caf_program
>>   integer :: a[*] = 7
>>   a = 8
>> end program caf_program
>> ------------- </ test.f90 >-----------------
>>
>> is turned into the following tree (-fdump-tree-original)
>>
>> ------------- < test.f90.003t.original >-----------------
>> _caf_init.1 ()
>> {
>>   a = (integer(kind=4) * restrict) _gfortran_caf_register (4, 0, 
>> &caf_token.0, 0B, 0B, 0);
>>   *a = 7;
>> }
>>
>> caf_program ()
>> {
>>   static void * caf_token.0;
>>   static integer(kind=4) * restrict a;
>>   void _caf_init.1 (void);
>>
>>   (integer(kind=4)) *a = 8;
>> }
>>
>> main (integer(kind=4) argc, character(kind=1) * * argv)
>> {
>>   static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};
>>
>>   _gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image, 
>> &_gfortran_caf_num_images);
>>   _gfortran_set_args (argc, argv);
>>   _gfortran_set_options (8, &options.2[0]);
>>   _gfortran_caf_sync_all (0B, 0);
>>   caf_program ();
>>   __sync_synchronize ();
>>   _gfortran_caf_finalize ();
>>   return 0;
>> }
>> ------------- </ test.f90.003t.original >-----------------
>>
>> Note: By construction, _gfortran_caf_register is called before 
>> _gfortran_caf_init; thus, the MPI library will be initialized by the 
>> first _gfortran_caf_register call, unless the program does not have 
>> any nonallocatable coarrays.
>>
>> No test cases, but the ones in gfortran.dg/coarray/ should already 
>> test this functionality.
>>
>> To be done in later patches:
>> - Coarrays declared in modules (module variables)
>> - Allocatable coarrays
>>
>> Note: As constructors are never optimized away [unless they are 
>> pure/const], static coarrays and also uncalled functions containing 
>> static coarrays will not be optimized away. (Cf. PRs middle-end/49106 
>> and middle-end/49108.)
>>
>> Bootstrapped and regtested on x86-64-linux.
>> OK for the trunk?
>>
>> Tobias
>

Re: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Paul Richard Thomas]

Dear Tobias,

This looks fine to me.  It does the things that you described and is
well hidden behind the co-array associated conditions.  Thus it is OK
for trunk.

Maybe I am being stupid but what is the call, in the testcase, to
subroutine test for?

Cheers

Paul

Re: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Paul Richard Thomas]

> However, I forgot the [*]  (or [3,*] or ...). Fortunately, you
> have spotted the sematically relevant typo!
>

;-)

Paul

Re: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays

[Tobias Burnus]

Dear Paul,

thanks for the review. Regarding:

Paul Thomas wrote:
> Maybe I am being stupid but what is the call, in the
> testcase, to subroutine test for?


Well, it is supposed to test coarray decls in functions,
contained functions, and in not-referenced functions.

However, I forgot the [*]  (or [3,*] or ...). Fortunately, you
have spotted the sematically relevant typo!

Tobias