Implement stat and errmsg.

gcc/fortran/ChangeLog:

	* trans-decl.c (gfc_sym_mangled_function_id): Whitespace fix.
	(gfc_build_builtin_function_decls): Correct fn specs.
	* trans-intrinsic.c (trans_argument): Re-apply fix (?)
	(conv_cas_reduce): Likewise.
	(conv_co_collective): Likewise.

libgfortran/ChangeLog:

	* Makefile.am: Add counter_barrier.c and counter_barrier.h
	* Makefile.in: Regenerate.
	* generated/nca_minmax_i1.c: Regenerated.
	* generated/nca_minmax_i16.c: Regenerated.
	* generated/nca_minmax_i2.c: Regenerated.
	* generated/nca_minmax_i4.c: Regenerated.
	* generated/nca_minmax_i8.c: Regenerated.
	* generated/nca_minmax_r10.c: Regenerated.
	* generated/nca_minmax_r16.c: Regenerated.
	* generated/nca_minmax_r4.c: Regenerated.
	* generated/nca_minmax_r8.c: Regenerated.
	* generated/nca_minmax_s1.c: Regenerated.
	* generated/nca_minmax_s4.c: Regenerated.
	* m4/nca-minmax-s.m4: Add stat and errmsg.
	* m4/nca_minmax.m4: Likewise.
	* nca/coarraynative.c (get_master): New function.
	(test_for_cas_errors): New function.
	(master_is_image_active): New function.
	(master_get_num_active_images): New function.
	(master_bind_active_image_barrier): New function.
	(error_on_missing_images): New function.
	(cas_master): New function.
	* nca/collective_subroutine.c (collsub_sync): Replace pthread_barrier_wait
	by counter_barrier.
	(collsub_reduce_array): Add error_on_missing_images. Adjust to number of
	images.
	(collsub_reduce_scalar): Likewise.
	(collsub_iface_init): Likewise.
	* nca/collective_subroutine.h: Replace pthread_barrier_t by counter_barrier.
	* nca/libcoarraynative.h: Include counter_barrier.h.  Add handling
	for failed images, stat and errmsg.
	* nca/sync.c (sync_all_init): Replace pthread_barrir by counter_barrier.
	(sync_iface_init): Adjust handling to total_num_images.
	(sync_table): Likewise.
	(sync_all): LIkewise.
	* nca/sync.h: Include some theaders, adjust to counter_barrier.
	* nca/util.h: Add internal_proto to unpack_array_finish.
	* nca/wrapper.c (cas_collsub_reduce_array): Adjust to total_num_images,
	handle status and errmsg.
	(cas_collsub_reduce_scalar): Likewise.
	(cas_collsub_broadcast_array): Likewise.
	(cas_collsub_broadcast_scalar): Likewise.
	(cas_coarray_alloc): Likewise.
	(cas_coarray_free): Likewise.
	(cas_coarray_num_images): Likewise.
	(cas_coarray_sync_all): Likewise.
	(cas_sync_images): Likewise.
	* nca/counter_barrier.c: New file.
	* nca/counter_barrier.h: New file.

2 files changed, 73 insertions, 32 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ff429d9..4f5b8f0 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -460,7 +460,7 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
     return get_identifier (sym->binding_label);
 
   if ((sym->module == NULL || sym->attr.proc == PROC_EXTERNAL
-      || (sym->module != NULL && (sym->attr.external
+       || (sym->module != NULL && (sym->attr.external
 	    || sym->attr.if_source == IFSRC_IFBODY)))
       && !sym->attr.module_procedure)
     {
@@ -4141,39 +4141,52 @@ gfc_build_builtin_function_decls (void)
 	get_identifier (PREFIX("cas_coarray_sync_all")), ". X ", void_type_node, 1,
 	build_pointer_type (integer_type_node), NULL_TREE);
       gfor_fndecl_cas_sync_images = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("cas_sync_images")), ". R R X X X ",
+	get_identifier (PREFIX("cas_sync_images")), ". R R w w . ",
 	void_type_node,
 	5, integer_type_node, pint_type, pint_type,
-	pchar_type_node, size_type_node, NULL_TREE);
+	pchar_type_node, size_type_node);
       gfor_fndecl_cas_lock = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("cas_lock")), ". w ", void_type_node, 1,
-	pvoid_type_node, NULL_TREE);
+	pvoid_type_node);
       gfor_fndecl_cas_unlock = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("cas_unlock")), ". w ", void_type_node, 1,
-	pvoid_type_node, NULL_TREE);
+	pvoid_type_node);
 
       gfor_fndecl_cas_reduce_scalar =
 	gfc_build_library_function_decl_with_spec (
-	  get_identifier (PREFIX("cas_collsub_reduce_scalar")), ". w r W ",
-	  void_type_node, 3, pvoid_type_node,
+	  get_identifier (PREFIX("cas_collsub_reduce_scalar")), ". w . r r w w . ",
+	  void_type_node, 7, pvoid_type_node,  /* object.  */
+	  size_type_node,	/* elem_size.  */
 	  build_pointer_type (build_function_type_list (void_type_node,
-	      pvoid_type_node, pvoid_type_node, NULL_TREE)),
-	  pint_type, NULL_TREE);
+	      pvoid_type_node, pvoid_type_node, NULL_TREE)), /* assign function.  */
+	  pint_type,	/* result_image.  */
+	  pint_type,	/* stat.  */
+	  pchar_type_node,	/* errmsg.  */
+	  size_type_node	/* errmsg_len.  */);
 
       gfor_fndecl_cas_reduce_array = 
 	gfc_build_library_function_decl_with_spec (
-	  get_identifier (PREFIX("cas_collsub_reduce_array")), ". w r W R ",
-	  void_type_node, 4, pvoid_type_node,
+	  get_identifier (PREFIX("cas_collsub_reduce_array")), ". W r r w w . ",
+	  void_type_node, 6, pvoid_type_node /* desc.  */,
 	  build_pointer_type (build_function_type_list (void_type_node,
-	      pvoid_type_node, pvoid_type_node, NULL_TREE)),
-	  pint_type, integer_type_node, NULL_TREE);
+	      pvoid_type_node, pvoid_type_node, NULL_TREE)) /* assign function.  */,
+	  pint_type,	/* result_image.  */ 
+	  pint_type,	/* stat.  */
+	  pchar_type_node,	/* errmsg.  */
+	  size_type_node	/* errmsg_len.  */  );
 
       gfor_fndecl_cas_broadcast_scalar = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX ("cas_collsub_broadcast_scalar")), ". w . . ",
-	void_type_node, 3, pvoid_type_node, size_type_node, integer_type_node);
+	get_identifier (PREFIX ("cas_collsub_broadcast_scalar")), ". w . . w w . ",
+	void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
+	  pint_type,	/* stat.  */
+	  pchar_type_node,	/* errmsg.  */
+	  size_type_node	/* errmsg_len.  */  );
       gfor_fndecl_cas_broadcast_array = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX ("cas_collsub_broadcast_array")), ". W . ",
-	void_type_node, 2, pvoid_type_node, integer_type_node);
+	get_identifier (PREFIX ("cas_collsub_broadcast_array")), ". W . w w . ",
+	void_type_node, 5, pvoid_type_node, integer_type_node,
+	  pint_type,	/* stat.  */
+	  pchar_type_node,	/* errmsg.  */
+	  size_type_node	/* errmsg_len.  */  );
     }
 
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index f9df1c9..7824dcf 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11098,34 +11098,42 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
     }
 }
 
-/* Helper function - translate an argument and advance to the next.  
-   Coarrays are irrelevant here, since we just translate normal arguments.  */
+/* Helper function - translate an argument and advance to the next.
+   Coarrays are irrelevant here, since we just translate normal
+   arguments.  */
 
 static tree
 trans_argument (gfc_actual_arglist **curr_al, stmtblock_t *blk,
 	        stmtblock_t *postblk, gfc_se *argse, tree def)
 {
-  if (!(*curr_al)->expr)
+  gfc_expr *expr = (*curr_al)->expr;
+
+  *curr_al = (*curr_al)->next;
+
+  if (expr == NULL)
     return def;
-  if ((*curr_al)->expr->rank > 0)
-    gfc_conv_expr_descriptor (argse, (*curr_al)->expr);
+
+  if (expr->rank > 0)
+    gfc_conv_expr_descriptor (argse, expr);
   else
-    gfc_conv_expr (argse, (*curr_al)->expr);
+    gfc_conv_expr (argse, expr);
+
   gfc_add_block_to_block (blk, &argse->pre);
   gfc_add_block_to_block (postblk, &argse->post);
-  *curr_al = (*curr_al)->next;
+
   return argse->expr;
 }
 
-/* Convert CO_REDUCE for native coarrays.  */
+/* Convert CO_REDUCE for shared coarrays.  */
 
 static tree
 conv_cas_reduce (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk)
 {
   gfc_actual_arglist *curr_al;
-  tree var, reduce_op, result_image, elem_size;
+  tree var, reduce_op, result_image, elem_size, stat, errmsg, errmsg_len;
   gfc_se argse;
   int is_array;
+  bool has_errmsg;
 
   curr_al = code->ext.actual;
 
@@ -11144,14 +11152,34 @@ conv_cas_reduce (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk)
   argse.want_pointer = 1;
   result_image = trans_argument (&curr_al, blk, postblk, &argse,
 				 null_pointer_node);
-  
+
+  gfc_init_se (&argse, NULL);
+  argse.want_pointer = 1;
+  stat = trans_argument (&curr_al, blk, postblk, &argse, null_pointer_node);
+
+  has_errmsg = curr_al->expr != NULL;
+  gfc_init_se (&argse, NULL);
+  argse.want_pointer = 1;
+  errmsg = trans_argument (&curr_al, blk, postblk, &argse, null_pointer_node);
+
+  if (has_errmsg)
+    {
+      errmsg_len = fold_convert (size_type_node, argse.string_length);
+    }
+  else
+    {
+      errmsg_len = build_zero_cst (size_type_node);
+    }
+
   if (is_array)
     return build_call_expr_loc (input_location, gfor_fndecl_cas_reduce_array,
-				3, var, reduce_op, result_image);
+				6, var, reduce_op, result_image, stat, errmsg,
+				errmsg_len);
 
   elem_size = size_in_bytes(TREE_TYPE(TREE_TYPE(var)));
-  return build_call_expr_loc (input_location, gfor_fndecl_cas_reduce_scalar, 4,
-			      var, elem_size, reduce_op, result_image);
+  return build_call_expr_loc (input_location, gfor_fndecl_cas_reduce_scalar, 7,
+			      var, elem_size, reduce_op, result_image, stat,
+			      errmsg, errmsg_len);
 }
 
 static tree
@@ -11184,7 +11212,7 @@ conv_cas_broadcast (gfc_code *code, stmtblock_t *blk, stmtblock_t *postblk)
 
 static tree conv_co_collective (gfc_code *);
 
-/* Convert collective subroutines for native coarrays.  */
+/* Convert collective subroutines for shared coarrays.  */
 
 static tree
 conv_cas_collective (gfc_code *code)
@@ -11336,7 +11364,7 @@ conv_co_collective (gfc_code *code)
       errmsg_len = build_zero_cst (size_type_node);
     }
 
-  /* For native coarrays, we only come here for CO_BROADCAST.  */
+  /* For shared coarrays, we only come here for CO_BROADCAST.  */
 
   gcc_assert (code->resolved_isym->id == GFC_ISYM_CO_BROADCAST
 	      || flag_coarray != GFC_FCOARRAY_SHARED);