diff mbox

[Fortran] PR 18918 - Fix/Add multi-image support to UCOBOUND

Message ID 4D9B54FD.2050408@net-b.de
State New
Headers show

Commit Message

Tobias Burnus April 5, 2011, 5:44 p.m. UTC 
This patch adds multi-image support to UCOBOUND. In the -fcoarray=single 
case, the last dimension is just "LCOARRAY (coarray, dim=corank)". 
However, if there are multiple images, one has for corank-1 coarrays: 
"lcobound(coarray) + num_images() -1" and for multi-rank coarrays for 
the last dimension "lcobound(coarray, dim=corank) + ceiling (real 
(num_images ()) / real (size)) - 1", where size is the product of the 
extends in all but the last codimension.

Well, that's actually all the patch does. (Except that "ceiling(N/S)-1" 
is replaced by "(N+S-1)/S-1" = "(N-1)/S".)

Build an regtested on x86-64-linux.
OK for the trunk?

(Sorry, no test case. I think one should soon start to create a 
-fcoarray=lib version of the test suite, where one passes the link (e.g. 
"$DIR/mpi.o $MPI_LIB" or "$DIR/single.o") and run command (e.g. "mpiexec 
-n 3" or "") via environment variables.)

Tobias

PS: We should soon work again on the regressions. Currently there are 10 
regressions of which 6 are GCC 4.6/4.7 regressions - and 1 is 4.7 only. 
We should fix all of the 4.6/4.7 regressions before the GCC 4.6.1 release!

PPS: Maybe someone understands why UCOBOUND(corank_1_coarray) for which 
one has the pseudo code:
    D = [codim=1].lbound + num_image - 1
gets translated as:
    D.1571 = (integer(kind=4)) (((character(kind=4)) 
parm.2.dim[NON_LVALUE_EXPR <S.1> + 1].lbound + (character(kind=4)) 
_gfortran_caf_num_images.4) + 4294967295);

Namely: Why are there all those casts to "character(kind=4)" and why is 
"+ (-1)" converted into 4294967295? The result surely works, but the 
dump looks odd.

Comments

Tobias Burnus April 10, 2011, 8:35 a.m. UTC | #1 
*ping*

http://gcc.gnu.org/ml/fortran/2011-04/msg00041.html

On 05.04.2011 19:44, Tobias Burnus wrote:
> This patch adds multi-image support to UCOBOUND. In the 
> -fcoarray=single case, the last dimension is just "LCOARRAY (coarray, 
> dim=corank)". However, if there are multiple images, one has for 
> corank-1 coarrays: "lcobound(coarray) + num_images() -1" and for 
> multi-rank coarrays for the last dimension "lcobound(coarray, 
> dim=corank) + ceiling (real (num_images ()) / real (size)) - 1", where 
> size is the product of the extends in all but the last codimension.
>
> Well, that's actually all the patch does. (Except that 
> "ceiling(N/S)-1" is replaced by "(N+S-1)/S-1" = "(N-1)/S".)
>
> Build an regtested on x86-64-linux.
> OK for the trunk?
Mikael Morin April 11, 2011, 12:05 p.m. UTC | #2 
On Tuesday 05 April 2011 19:44:29 Tobias Burnus wrote:
> This patch adds multi-image support to UCOBOUND. In the -fcoarray=single
> case, the last dimension is just "LCOARRAY (coarray, dim=corank)".
> However, if there are multiple images, one has for corank-1 coarrays:
> "lcobound(coarray) + num_images() -1" and for multi-rank coarrays for
> the last dimension "lcobound(coarray, dim=corank) + ceiling (real
> (num_images ()) / real (size)) - 1", where size is the product of the
> extends in all but the last codimension.
> 
> Well, that's actually all the patch does. (Except that "ceiling(N/S)-1"
> is replaced by "(N+S-1)/S-1" = "(N-1)/S".)
> 
> Build an regtested on x86-64-linux.
> OK for the trunk?
OK. Thanks

> 
> (Sorry, no test case. I think one should soon start to create a
> -fcoarray=lib version of the test suite, where one passes the link (e.g.
> "$DIR/mpi.o $MPI_LIB" or "$DIR/single.o") and run command (e.g. "mpiexec
> -n 3" or "") via environment variables.)
This is needed. However, to achieve better test coverage, we should avoid 
requiring the user to tweak the testsuite as much as possible. That is, test -
fcoarray=lib option with every libcaf by default, skipping the mpi one (for 
example) if libcaf_mpi was not built. 


> PPS: Maybe someone understands why UCOBOUND(corank_1_coarray) for which
> one has the pseudo code:
>     D = [codim=1].lbound + num_image - 1
> gets translated as:
>     D.1571 = (integer(kind=4)) (((character(kind=4))
> parm.2.dim[NON_LVALUE_EXPR <S.1> + 1].lbound + (character(kind=4))
> _gfortran_caf_num_images.4) + 4294967295);
> 
> Namely: Why are there all those casts to "character(kind=4)" and why is
> "+ (-1)" converted into 4294967295? The result surely works, but the
> dump looks odd.

You could try casting gfort_gvar_caf_num_images explicitely to 
gfc_array_index_type. Otherwise I don't know. Might be a bug.


Mikael
diff mbox

Patch

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

	PR fortran/18918
	* simplify.c (simplify_bound_dim): Exit for
	ucobound's last dimension unless -fcoarray=single.
	* trans-array (gfc_conv_descriptor_size_1): Renamed from
	gfc_conv_descriptor_size, made static, has now from_dim and
	to_dim arguments.
	(gfc_conv_descriptor_size): Call gfc_conv_descriptor_size.
	(gfc_conv_descriptor_cosize): New function.
	* trans-array.h (gfc_conv_descriptor_cosize): New prototype.
	* trans-intrinsic.c (conv_intrinsic_cobound): Add input_location
	and handle last codim of ucobound for when -fcoarray is not "single".

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 2a99445..abc3383 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3298,7 +3298,8 @@  simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
 
   /* The last dimension of an assumed-size array is special.  */
   if ((!coarray && d == as->rank && as->type == AS_ASSUMED_SIZE && !upper)
-      || (coarray && d == as->rank + as->corank))
+      || (coarray && d == as->rank + as->corank
+	  && (!upper || gfc_option.coarray == GFC_FCOARRAY_SINGLE)))
     {
       if (as->lower[d-1]->expr_type == EXPR_CONSTANT)
 	{
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0046d0a..f8e26b0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4055,17 +4055,17 @@  gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
 
 
 /* For an array descriptor, get the total number of elements.  This is just
-   the product of the extents along all dimensions.  */
+   the product of the extents along from_dim to to_dim.  */
 
-tree
-gfc_conv_descriptor_size (tree desc, int rank)
+static tree
+gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
 {
   tree res;
   int dim;
 
   res = gfc_index_one_node;
 
-  for (dim = 0; dim < rank; ++dim)
+  for (dim = from_dim; dim < to_dim; ++dim)
     {
       tree lbound;
       tree ubound;
@@ -4083,6 +4083,24 @@  gfc_conv_descriptor_size (tree desc, int rank)
 }
 
 
+/* Full size of an array.  */
+
+tree
+gfc_conv_descriptor_size (tree desc, int rank)
+{
+  return gfc_conv_descriptor_size_1 (desc, 0, rank);
+}
+
+
+/* Size of a coarray for all dimensions but the last.  */
+
+tree
+gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
+{
+  return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
+}
+
+
 /* Helper function for marking a boolean expression tree as unlikely.  */
 
 static tree
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1b35759..fef56ae 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -164,3 +164,4 @@  void gfc_trans_string_copy (stmtblock_t *, tree, tree, int, tree, tree, int);
 /* Calculate extent / size of an array.  */
 tree gfc_conv_array_extent_dim (tree, tree, tree*);
 tree gfc_conv_descriptor_size (tree, int);
+tree gfc_conv_descriptor_cosize (tree, int, int);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 9a69632..0c2ce51 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1170,10 +1170,10 @@  conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
       tree_rank = gfc_conv_mpz_to_tree (mpz_rank, gfc_index_integer_kind);
 
       bound = se->loop->loopvar[0];
-      bound = fold_build2 (PLUS_EXPR, gfc_array_index_type, bound,
-			   se->ss->data.info.delta[0]);
-      bound = fold_build2 (PLUS_EXPR, gfc_array_index_type, bound,
-			   tree_rank);
+      bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			       bound, se->ss->data.info.delta[0]);
+      bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			       bound, tree_rank);
       gfc_advance_se_ss_chain (se);
     }
   else
@@ -1199,11 +1199,13 @@  conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
       else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
         {
 	  bound = gfc_evaluate_now (bound, &se->pre);
-	  cond = fold_build2 (LT_EXPR, boolean_type_node,
-			      bound, build_int_cst (TREE_TYPE (bound), 1));
+	  cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+				  bound, build_int_cst (TREE_TYPE (bound), 1));
 	  tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
-	  tmp = fold_build2 (GT_EXPR, boolean_type_node, bound, tmp);
-	  cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp);
+	  tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+				 bound, tmp);
+	  cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
+				  boolean_type_node, cond, tmp);
 	  gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
 				   gfc_msg_fault);
 	}
@@ -1213,26 +1215,74 @@  conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
       switch (arg->expr->rank)
 	{
 	case 0:
-	  bound = fold_build2 (MINUS_EXPR, gfc_array_index_type, bound,
-			       gfc_index_one_node);
+	  bound = fold_build2_loc (input_location, MINUS_EXPR,
+				   gfc_array_index_type, bound,
+				   gfc_index_one_node);
 	case 1:
 	  break;
 	default:
-	  bound = fold_build2 (PLUS_EXPR, gfc_array_index_type, bound,
-			       gfc_rank_cst[arg->expr->rank - 1]);
+	  bound = fold_build2_loc (input_location, PLUS_EXPR,
+				   gfc_array_index_type, bound,
+				   gfc_rank_cst[arg->expr->rank - 1]);
 	}
     }
 
   resbound = gfc_conv_descriptor_lbound_get (desc, bound);
 
+  /* Handle UCOBOUND with special handling of the last codimension.  */
   if (expr->value.function.isym->id == GFC_ISYM_UCOBOUND)
     {
-      cond = fold_build2 (EQ_EXPR, boolean_type_node, bound,
-			  build_int_cst (TREE_TYPE (bound),
-			  arg->expr->rank + corank - 1));
-      resbound2 = gfc_conv_descriptor_ubound_get (desc, bound);
-      se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
-			      resbound, resbound2);
+      /* Last codimension: For -fcoarray=single just return
+	 the lcobound - otherwise add
+	   ceiling (real (num_images ()) / real (size)) - 1
+	 = (num_images () + size - 1) / size - 1
+	 = (num_images - 1) / size(),
+         where size is the product of the extend of all but the last
+	 codimension.  */
+
+      if (gfc_option.coarray != GFC_FCOARRAY_SINGLE && corank > 1)
+	{
+          tree cosize;
+
+	  gfc_init_coarray_decl ();
+	  cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
+
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 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,
+				 fold_convert (gfc_array_index_type, cosize));
+	  resbound = fold_build2_loc (input_location, PLUS_EXPR,
+				      gfc_array_index_type, resbound, tmp);
+	}
+      else if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
+	{
+	  /* ubound = lbound + num_images() - 1.  */
+	  gfc_init_coarray_decl ();
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 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);
+	}
+
+      if (corank > 1)
+	{
+	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				  bound,
+				  build_int_cst (TREE_TYPE (bound),
+						 arg->expr->rank + corank - 1));
+
+	  resbound2 = gfc_conv_descriptor_ubound_get (desc, bound);
+	  se->expr = fold_build3_loc (input_location, COND_EXPR,
+				      gfc_array_index_type, cond,
+				      resbound, resbound2);
+	}
+      else
+	se->expr = resbound;
     }
   else
     se->expr = resbound;