Andre Vehreschild wrote:
PS That's good news about the funding. Maybe we will get to see "built in"
coarrays soon?
You hopefully will see Nikolas work on the shared memory coarray support, if
that is what you mean by "built in" coarrays. I will be working on the
distributed memory coarray support esp. fixing the module issues and some other
team related things.

Cool! (Both of it.)

I assume "distributed memory coarray support" is still based on Open
Coarrays?

* * *

I am asking because there is coarray API being defined: Parallel Runtime
Interface for Fortran (PRIF), https://go.lbl.gov/prif

with an implementation called Caffeine – CoArray Fortran Framework of
Efficient Interfaces to Network Environments,
https://crd.lbl.gov/caffeine which uses GASNet or POSIX processes.

Well, the among the implementers is (unsurprising?) Damian – and the
idea seems to be that LLVM's FLANG will use the API.

Tobias

PS: I think it might be useful in the long run to support both
PRIF/Caffeine and OpenCoarrays.

I have attached my hello-world patch for -fcoarray=prif that I wrote
after ISC-HPC; it only handles this_image() / num_images() + init/stop.
I got confirmation by the PRIF developers that the next revision will
permit calling __prif_MOD_prif_init multiple times such that one can use
it in the constructor for static coarrays, which won't work otherwise.
gcc/ChangeLog:

	* flag-types.h (enum gfc_fcoarray):

gcc/fortran/ChangeLog:

	* invoke.texi:
	* lang.opt:
	* trans-decl.cc (gfc_build_builtin_function_decls):
	(create_main_function):
	* trans-intrinsic.cc (trans_this_image):
	(trans_num_images):
	* trans.h (GTY):

 gcc/flag-types.h               |  3 ++-
 gcc/fortran/invoke.texi        |  7 +++++-
 gcc/fortran/lang.opt           |  5 +++-
 gcc/fortran/trans-decl.cc      | 56 ++++++++++++++++++++++++++++++++++++++++--
 gcc/fortran/trans-intrinsic.cc | 42 +++++++++++++++++++++++++++----
 gcc/fortran/trans.h            |  5 ++++
 6 files changed, 108 insertions(+), 10 deletions(-)

diff --git a/gcc/flag-types.h b/gcc/flag-types.h
index 5a2b461fa75..babd747c01d 100644
--- a/gcc/flag-types.h
+++ b/gcc/flag-types.h
@@ -427,7 +427,8 @@ enum gfc_fcoarray
 {
   GFC_FCOARRAY_NONE = 0,
   GFC_FCOARRAY_SINGLE,
-  GFC_FCOARRAY_LIB
+  GFC_FCOARRAY_LIB,
+  GFC_FCOARRAY_PRIF
 };
 
 
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 40e8e4a7cdd..331a40d31db 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -1753,7 +1753,12 @@ Single-image mode, i.e. @code{num_images()} is always one.
 
 @item @samp{lib}
 Library-based coarray parallelization; a suitable GNU Fortran coarray
-library needs to be linked.
+library needs to be linked such as @url{http://opencoarrays.org}.
+
+@item @samp{prif}
+Using the Parallel Runtime Interface for Fortran (PRIF),
+@url{https://go.lbl.gov/@/prif}; for instance, via Caffeine,
+@url{https://go.lbl.gov/@/caffeine}.
 @end table
 
 
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 5efd4a0129a..9ba957d5571 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -786,7 +786,7 @@ Copy array sections into a contiguous block on procedure entry.
 
 fcoarray=
 Fortran RejectNegative Joined Enum(gfc_fcoarray) Var(flag_coarray) Init(GFC_FCOARRAY_NONE)
--fcoarray=<none|single|lib>	Specify which coarray parallelization should be used.
+-fcoarray=<none|single|lib|prif>	Specify which coarray parallelization should be used.
 
 Enum
 Name(gfc_fcoarray) Type(enum gfc_fcoarray) UnknownError(Unrecognized option: %qs)
@@ -800,6 +800,9 @@ Enum(gfc_fcoarray) String(single) Value(GFC_FCOARRAY_SINGLE)
 EnumValue
 Enum(gfc_fcoarray) String(lib) Value(GFC_FCOARRAY_LIB)
 
+EnumValue
+Enum(gfc_fcoarray) String(prif) Value(GFC_FCOARRAY_PRIF)
+
 fcheck=
 Fortran RejectNegative JoinedOrMissing
 -fcheck=[...]	Specify which runtime checks are to be performed.
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dca7779528b..d1c0e2ee997 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -170,6 +170,10 @@ tree gfor_fndecl_co_sum;
 tree gfor_fndecl_caf_is_present;
 tree gfor_fndecl_caf_random_init;
 
+tree gfor_fndecl_prif_init;
+tree gfor_fndecl_prif_stop;
+tree gfor_fndecl_prif_this_image_no_coarray;
+tree gfor_fndecl_prif_num_images;
 
 /* Math functions.  Many other math functions are handled in
    trans-intrinsic.cc.  */
@@ -4147,6 +4151,31 @@ gfc_build_builtin_function_decls (void)
 	    get_identifier (PREFIX("caf_random_init")),
 	    void_type_node, 2, logical_type_node, logical_type_node);
     }
+  else if (flag_coarray == GFC_FCOARRAY_PRIF)
+    {
+      tree pint_type = build_pointer_type (integer_type_node);
+      tree pbool_type = build_pointer_type (boolean_type_node);
+      tree pintmax_type_node = get_typenode_from_name (INTMAX_TYPE);
+      pintmax_type_node = build_pointer_type (pintmax_type_node);
+
+      gfor_fndecl_prif_init = gfc_build_library_function_decl_with_spec (
+	get_identifier ("__prif_MOD_prif_init"), ". W ",
+	void_type_node, 1, pint_type);
+
+      gfor_fndecl_prif_stop = gfc_build_library_function_decl_with_spec (
+	get_identifier ("__prif_MOD_prif_stop"), ". R R R ", void_type_node,
+	4, pbool_type, pint_type, pchar_type_node, gfc_charlen_type_node);
+
+      gfor_fndecl_prif_this_image_no_coarray =
+	gfc_build_library_function_decl_with_spec (
+	  get_identifier ("__prif_MOD_prif_this_image_no_coarray"), ". R W ",
+	void_type_node, 2, pvoid_type_node, pint_type);
+
+      gfor_fndecl_prif_num_images = gfc_build_library_function_decl_with_spec (
+	get_identifier ("__prif_MOD_prif_num_images"), ". R W ", void_type_node,
+	3, pvoid_type_node, pintmax_type_node,
+	pint_type);
+    }
 
   gfc_build_intrinsic_function_decls ();
   gfc_build_intrinsic_lib_fndecls ();
@@ -6507,9 +6536,9 @@ create_main_function (tree fndecl)
 
   /* Call some libgfortran initialization routines, call then MAIN__().  */
 
-  /* Call _gfortran_caf_init (*argc, ***argv).  */
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
+      /* Call _gfortran_caf_init (*argc, ***argv).  */
       tree pint_type, pppchar_type;
       pint_type = build_pointer_type (integer_type_node);
       pppchar_type
@@ -6520,6 +6549,16 @@ create_main_function (tree fndecl)
 		gfc_build_addr_expr (pppchar_type, argv));
       gfc_add_expr_to_block (&body, tmp);
     }
+  else if (flag_coarray == GFC_FCOARRAY_PRIF)
+    {
+      /* Call prif_init (*exit_code).  */
+      tree exit_code = create_tmp_var_raw (integer_type_node, "exit_code");
+      pushdecl (exit_code);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_prif_init, 1,
+				 gfc_build_addr_expr (NULL, exit_code));
+      gfc_add_expr_to_block (&body, tmp);
+// FIXME: Handle exit code?
+    }
 
   /* Call _gfortran_set_args (argc, argv).  */
   TREE_USED (argc) = 1;
@@ -6634,12 +6673,25 @@ create_main_function (tree fndecl)
   /* Mark MAIN__ as used.  */
   TREE_USED (fndecl) = 1;
 
-  /* Coarray: Call _gfortran_caf_finalize(void).  */
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
+      /* Call _gfortran_caf_finalize(void).  */
       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_finalize, 0);
       gfc_add_expr_to_block (&body, tmp);
     }
+  else if (flag_coarray == GFC_FCOARRAY_PRIF)
+    {
+      /* Call prif_stop(*quiet, *stop_code_int, *stop_code_char, _stop_code_char)
+	 as prif_stop(&true, NULL, NULL, 0).  */
+      tree quiet = create_tmp_var_raw (boolean_type_node, "quiet");
+      pushdecl (quiet);
+      gfc_add_modify (&body, quiet, boolean_true_node);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_prif_stop, 4,
+				 gfc_build_addr_expr (NULL, quiet), null_pointer_node,
+				 null_pointer_node,
+				 build_zero_cst (gfc_charlen_type_node));
+      gfc_add_expr_to_block (&body, tmp);
+    }
 
   /* "return 0".  */
   tmp = fold_build2_loc (input_location, MODIFY_EXPR, integer_type_node,
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 80dc3426ab0..a34d6a57688 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "memmodel.h"
 #include "tm.h"		/* For UNITS_PER_WORD.  */
 #include "tree.h"
+#include "gimple-expr.h"  /* For create_tmp_var_name.  */
 #include "gfortran.h"
 #include "trans.h"
 #include "stringpool.h"
@@ -2386,6 +2387,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   /* Argument-free version: THIS_IMAGE().  */
   if (distance || expr->value.function.actual->expr == NULL)
     {
+// FIXME: Update comment; handle distance (== 'team' arg?)
       if (distance)
 	{
 	  gfc_init_se (&argse, NULL);
@@ -2396,8 +2398,23 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 	}
       else
 	tmp = integer_zero_node;
-      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
-				 tmp);
+      if (flag_coarray == GFC_FCOARRAY_LIB)
+	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image,
+				   1, tmp);
+      else if (flag_coarray == GFC_FCOARRAY_PRIF)
+	{
+	  tree image_index = create_tmp_var_raw (integer_type_node,
+						 "image_index");
+	  gfc_add_decl_to_function (image_index);
+	  tmp = build_call_expr_loc (input_location,
+				     gfor_fndecl_prif_this_image_no_coarray, 2,
+				     null_pointer_node, /* FIXME: team. */
+				     gfc_build_addr_expr (NULL, image_index));
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	  tmp = image_index;
+	}
+      else
+	gcc_unreachable ();
       se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
 			       tmp);
       return;
@@ -2799,7 +2816,7 @@ trans_num_images (gfc_se * se, gfc_expr *expr)
 {
   tree tmp, distance, failed;
   gfc_se argse;
-
+// FIXME: Handle team / team-numbe argument
   if (expr->value.function.actual->expr)
     {
       gfc_init_se (&argse, NULL);
@@ -2821,8 +2838,23 @@ trans_num_images (gfc_se * se, gfc_expr *expr)
     }
   else
     failed = build_int_cst (integer_type_node, -1);
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
-			     distance, failed);
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+			       distance, failed);
+  else if (flag_coarray == GFC_FCOARRAY_PRIF)
+    {
+      tree image_count = create_tmp_var_raw (integer_type_node, "image_count");
+      gfc_add_decl_to_function (image_count);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_prif_num_images, 3,
+				 null_pointer_node, /* FIXME: team. */
+				 null_pointer_node, /* FIXME: team_number. */
+				 gfc_build_addr_expr (NULL, image_count));
+      gfc_add_expr_to_block (&se->pre, tmp);
+      tmp = image_count;
+    }
+  else
+    gcc_unreachable ();
+
   se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
 }
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f94fa601400..adf4d406bba 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -920,6 +920,11 @@ extern GTY(()) tree gfor_fndecl_co_reduce;
 extern GTY(()) tree gfor_fndecl_co_sum;
 extern GTY(()) tree gfor_fndecl_caf_is_present;
 
+extern GTY(()) tree gfor_fndecl_prif_init;
+extern GTY(()) tree gfor_fndecl_prif_stop;
+extern GTY(()) tree gfor_fndecl_prif_this_image_no_coarray;
+extern GTY(()) tree gfor_fndecl_prif_num_images;
+
 /* Math functions.  Many other math functions are handled in
    trans-intrinsic.cc.  */
 

Reply via email to