This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.

Index Nav:	[Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav:	[Date Prev] [Date Next]	[Thread Prev] [Thread Next]
Other format:	[Raw text]

Re: [Fortran] Help with STAT= attribute in coarray reference

From: Mikael Morin <mikael dot morin at sfr dot fr>
To: Alessandro Fanfarillo <fanfarillo dot gcc at gmail dot com>, gfortran <fortran at gcc dot gnu dot org>
Date: Mon, 13 Jun 2016 20:31:01 +0200
Subject: Re: [Fortran] Help with STAT= attribute in coarray reference
Authentication-results: sourceware.org; auth=none
Authentication-results: sfr.fr; auth=pass (PLAIN) smtp dot auth=mikael dot morin at sfr dot fr
References: <CAHqFgjWiFxBfZq912sCXj-pJKMmFpGWQUoqpCJ98uewZcvz2MQ at mail dot gmail dot com> <CAHqFgjV_Fj_UkL=SGgMSPyJvEN-TUNKYGtgQhK-5RX7s6sr=eQ at mail dot gmail dot com>

Le 13/06/2016 19:16, Alessandro Fanfarillo a Ãcrit :

Dear all,

in attachment there is a working patch for adding the STAT= attribute
to coarray get and put needed by Failed Images (TS 18508).

E.g.:

integer,dimension(10) :: a[*]
integer :: stat

a(:) = a(:)[num_images(),stat=stat]


In order to pass the variable assigned during the coarray reference I
had to modify the gfc_array_ref structure by adding a gfc_expr* field.
By doing so, I'm able to store the stat variable in the descriptor and
pass it to the OpenCoarrays routines at the right moment.

Is there a better way of doing it?

Array ref and coarray ref should have been separated when we introducedcoarrays, as they are really different things.

Appart from that, I think your way is the natural way of doing it.

Comments below about the patch. It's mostly good.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 1430e80..232bae7 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -156,6 +156,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
 {
   match m;
   bool matched_bracket = false;
+  gfc_expr *tmp;

   memset (ar, '\0', sizeof (*ar));

@@ -226,6 +227,11 @@ coarray:
       if (m == MATCH_ERROR)
 	return MATCH_ERROR;

+      if(gfc_match(",stat=%e",&tmp) == MATCH_YES)

Add spaces between the tokens to match for optional whitespace.
(tests welcome for this)
An error is missing for multiple stat=
(tests welcome as well)

+	ar->stat = tmp;
+      else
+	ar->stat = NULL;
+
       if (gfc_match_char (']') == MATCH_YES)
 	{
 	  ar->codimen++;
@@ -237,6 +243,11 @@ coarray:
 	    }
 	  if (ar->codimen > corank)
 	    {
+	      if(ar->stat)
+		{
+		  ar->codimen--;
+		  return MATCH_YES;
+		}

I don't understand this change.

If there are some extra codimension refs and a stat argument, you shouldstill emit a "Too many codimensions" error.

(Tests welcome for this)

 	      gfc_error ("Too many codimensions at %C, expected %d not %d",
 			 corank, ar->codimen);
 	      return MATCH_ERROR;
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index d1258cd..34a3557 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref)
   return true;
 }

+gfc_expr *
+gfc_find_stat_co(gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.stat;
+  return NULL;
+}

 bool
 gfc_is_coindexed (gfc_expr *e)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d87632..2f22c32 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref
   int dimen;			/* # of components in the reference */
   int codimen;
   bool in_allocate;		/* For coarray checks. */
+  gfc_expr *stat;
   locus where;
   gfc_array_spec *as;

@@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
-
+gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
 bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f56bdf1..54be70e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar)
     }

   /* ar->codimen == 0 is a local array.  */
-  if (as->corank != ar->codimen && ar->codimen != 0)
+  if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat)

I think stat is irrelevant here.

     {
       gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)",
 		 &ar->where, ar->codimen, as->corank);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 04339a6..1ee548a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3529,16 +3529,16 @@ gfc_build_builtin_function_decls (void)
         ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);

       gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 9,
+	get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 10,

The spec string ".R.RRRW" should be updated as well.

         pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
 	pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
-	boolean_type_node);
+	integer_type_node, boolean_type_node);

       gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 9,
+	get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 10,

Same here

         pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
 	pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
-	boolean_type_node);
+	pint_type, boolean_type_node);

       gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRR", void_type_node,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e5cc907..7d8123b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1100,10 +1100,10 @@ static void
 gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 			    tree may_require_tmp)
 {
-  gfc_expr *array_expr;
+  gfc_expr *array_expr, *tmp_stat;
   gfc_se argse;
   tree caf_decl, token, offset, image_index, tmp;
-  tree res_var, dst_var, type, kind, vec;
+  tree res_var, dst_var, type, kind, vec, stat;

   gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);

@@ -1122,6 +1122,16 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   dst_var = lhs;

   vec = null_pointer_node;
+  tmp_stat = gfc_find_stat_co(expr);
+
+  if(tmp_stat)

Space after if

+    {

Call gfc_init_se.

+      gfc_conv_expr_val (se, tmp_stat);

It's better to have one dedicated se per expression, like you did for send.

+      stat = se->expr;
+      stat = gfc_build_addr_expr (NULL, stat);

You can use gfc_conv_expr_reference directly.

+    }
+  else
+    stat = null_pointer_node;

   gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
@@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   ASM_VOLATILE_P (tmp) = 1;
   gfc_add_expr_to_block (&se->pre, tmp);

-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
 			     token, offset, image_index, argse.expr, vec,
-			     dst_var, kind, lhs_kind, may_require_tmp);
+			     dst_var, kind, lhs_kind, stat, may_require_tmp);
   gfc_add_expr_to_block (&se->pre, tmp);

   if (se->ss)
@@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,

 static tree
 conv_caf_send (gfc_code *code) {
-  gfc_expr *lhs_expr, *rhs_expr;
+  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-  tree may_require_tmp;
+  tree may_require_tmp, stat;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;

@@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) {
 		    ? boolean_false_node : boolean_true_node;
   gfc_init_block (&block);

+  stat = null_pointer_node;
+
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
   if (lhs_expr->rank == 0)
@@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) {

   rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);

+  tmp_stat = gfc_find_stat_co(lhs_expr);
+
+  if(tmp_stat)

space after if

+    {
+      gfc_se stat_se;
+      gfc_init_se (&stat_se, NULL);
+      gfc_conv_expr_val (&stat_se, tmp_stat);
+      stat = stat_se.expr;
+      stat = gfc_build_addr_expr (NULL, stat);

gfc_conv_expr_reference

For complex cases (say, pointer-returning functions), you'll need to addstat_se's pre block to se's pre block.

(Tests welcome for this)

+    }
+  else
+    stat = null_pointer_node;
+
   if (!gfc_is_coindexed (rhs_expr))
-    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token,
-			     offset, image_index, lhs_se.expr, vec,
-			     rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp);
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token,
+			       offset, image_index, lhs_se.expr, vec,
+			       rhs_se.expr, lhs_kind, rhs_kind, stat,
+			       may_require_tmp);
   else
     {
       tree rhs_token, rhs_offset, rhs_image_index;


More tests welcome ;-)

Follow-Ups:
- Re: [Fortran] Help with STAT= attribute in coarray reference
  - From: Alessandro Fanfarillo
- Re: [Fortran] Help with STAT= attribute in coarray reference
  - From: Alessandro Fanfarillo

References:
- [Fortran] Help with STAT= attribute in coarray reference
  - From: Alessandro Fanfarillo
- Re: [Fortran] Help with STAT= attribute in coarray reference
  - From: Alessandro Fanfarillo

Index Nav:	[Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav:	[Date Prev] [Date Next]	[Thread Prev] [Thread Next]