public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak
@ 2024-06-04 10:24 Andre Vehreschild
  2024-06-07  6:46 ` Paul Richard Thomas
  0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2024-06-04 10:24 UTC (permalink / raw)
  To: GCC-Fortran-ML, GCC-Patches-ML, everythingfunctional

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

Hi all,

attached patch fixes a memory leak when a user-defined function returns a
polymorphic type/class. The issue was, that the polymorphic type was not
detected correctly and therefore the len-field was not transferred correctly.

Regtests ok x86_64-linux/Fedora 39. Ok for master?

Regards,
	Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr90072_1.patch --]
[-- Type: text/x-patch, Size: 6735 bytes --]

From e79072de7279cc6863914588e4a0457f0c3493fd Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed, 19 Jul 2023 11:57:43 +0200
Subject: [PATCH] Fix returned type to be allocatable for user-functions.

The returned type of user-defined function returning a
class object was not detected and handled correctly, which
lead to memory leaks.

	PR fortran/90072

gcc/fortran/ChangeLog:

	* expr.cc (gfc_is_alloc_class_scalar_function): Detect
	allocatable class return types also for user-defined
	functions.
	* trans-expr.cc (gfc_conv_procedure_call): Same.
	(trans_class_vptr_len_assignment): Compute vptr len
	assignment correctly for user-defined functions.

gcc/testsuite/ChangeLog:

	* gfortran.dg/class_77.f90: New test.
---
 gcc/fortran/expr.cc                    | 13 ++--
 gcc/fortran/trans-expr.cc              | 35 +++++------
 gcc/testsuite/gfortran.dg/class_77.f90 | 83 ++++++++++++++++++++++++++
 3 files changed, 109 insertions(+), 22 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/class_77.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index a162744c719..be138d196a2 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5573,11 +5573,14 @@ bool
 gfc_is_alloc_class_scalar_function (gfc_expr *expr)
 {
   if (expr->expr_type == EXPR_FUNCTION
-      && expr->value.function.esym
-      && expr->value.function.esym->result
-      && expr->value.function.esym->result->ts.type == BT_CLASS
-      && !CLASS_DATA (expr->value.function.esym->result)->attr.dimension
-      && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable)
+      && ((expr->value.function.esym
+	   && expr->value.function.esym->result
+	   && expr->value.function.esym->result->ts.type == BT_CLASS
+	   && !CLASS_DATA (expr->value.function.esym->result)->attr.dimension
+	   && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable)
+	  || (expr->ts.type == BT_CLASS
+	      && CLASS_DATA (expr)->attr.allocatable
+	      && !CLASS_DATA (expr)->attr.dimension)))
     return true;

   return false;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9f6cc8f871e..d6f4d6bfe45 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8301,7 +8301,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	    }

 	  /* Finalize the result, if necessary.  */
-	  attr = CLASS_DATA (expr->value.function.esym->result)->attr;
+	  attr = expr->value.function.esym
+		 ? CLASS_DATA (expr->value.function.esym->result)->attr
+		 : CLASS_DATA (expr)->attr;
 	  if (!((gfc_is_class_array_function (expr)
 		 || gfc_is_alloc_class_scalar_function (expr))
 		&& attr.pointer))
@@ -10085,27 +10087,26 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
   if (re->expr_type != EXPR_VARIABLE && re->expr_type != EXPR_NULL
       && rse->expr != NULL_TREE)
     {
-      if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
-	class_expr = gfc_get_class_from_expr (rse->expr);
+      if (!DECL_P (rse->expr))
+	{
+	  if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
+	    class_expr = gfc_get_class_from_expr (rse->expr);

-      if (rse->loop)
-	pre = &rse->loop->pre;
-      else
-	pre = &rse->pre;
+	  if (rse->loop)
+	    pre = &rse->loop->pre;
+	  else
+	    pre = &rse->pre;

-      if (class_expr != NULL_TREE && UNLIMITED_POLY (re))
-	{
-	  tmp = TREE_OPERAND (rse->expr, 0);
-	  tmp = gfc_create_var (TREE_TYPE (tmp), "rhs");
-	  gfc_add_modify (&rse->pre, tmp, TREE_OPERAND (rse->expr, 0));
+	  if (class_expr != NULL_TREE && UNLIMITED_POLY (re))
+	      tmp = gfc_evaluate_now (TREE_OPERAND (rse->expr, 0), &rse->pre);
+	  else
+	      tmp = gfc_evaluate_now (rse->expr, &rse->pre);
+
+	  rse->expr = tmp;
 	}
       else
-	{
-	  tmp = gfc_create_var (TREE_TYPE (rse->expr), "rhs");
-	  gfc_add_modify (&rse->pre, tmp, rse->expr);
-	}
+	pre = &rse->pre;

-      rse->expr = tmp;
       temp_rhs = true;
     }

diff --git a/gcc/testsuite/gfortran.dg/class_77.f90 b/gcc/testsuite/gfortran.dg/class_77.f90
new file mode 100644
index 00000000000..ef38dd67743
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_77.f90
@@ -0,0 +1,83 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/90072
+!
+! Contributed by Brad Richardson  <everythingfunctional@protonmail.com>
+!
+
+module types
+    implicit none
+
+    type, abstract :: base_returned
+    end type base_returned
+
+    type, extends(base_returned) :: first_returned
+    end type first_returned
+
+    type, extends(base_returned) :: second_returned
+    end type second_returned
+
+    type, abstract :: base_called
+    contains
+        procedure(get_), deferred :: get
+    end type base_called
+
+    type, extends(base_called) :: first_extended
+    contains
+        procedure :: get => getFirst
+    end type first_extended
+
+    type, extends(base_called) :: second_extended
+    contains
+        procedure :: get => getSecond
+    end type second_extended
+
+    abstract interface
+        function get_(self) result(returned)
+            import base_called
+            import base_returned
+            class(base_called), intent(in) :: self
+            class(base_returned), allocatable :: returned
+        end function get_
+    end interface
+contains
+    function getFirst(self) result(returned)
+        class(first_extended), intent(in) :: self
+        class(base_returned), allocatable :: returned
+
+        allocate(returned, source = first_returned())
+    end function getFirst
+
+    function getSecond(self) result(returned)
+        class(second_extended), intent(in) :: self
+        class(base_returned), allocatable :: returned
+
+        allocate(returned, source = second_returned())
+    end function getSecond
+end module types
+
+program dispatch_memory_leak
+    implicit none
+
+    call run()
+contains
+    subroutine run()
+        use types, only: base_returned, base_called, first_extended
+
+        class(base_called), allocatable :: to_call
+        class(base_returned), allocatable :: to_get
+
+        allocate(to_call, source = first_extended())
+        allocate(to_get, source = to_call%get())
+
+        deallocate(to_get)
+        select type(to_call)
+        type is (first_extended)
+            allocate(to_get, source = to_call%get())
+        end select
+    end subroutine run
+end program dispatch_memory_leak
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
+
--
2.45.1


^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak
  2024-06-04 10:24 [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak Andre Vehreschild
@ 2024-06-07  6:46 ` Paul Richard Thomas
  2024-06-07  8:17   ` Andre Vehreschild
  0 siblings, 1 reply; 5+ messages in thread
From: Paul Richard Thomas @ 2024-06-07  6:46 UTC (permalink / raw)
  To: Andre Vehreschild; +Cc: GCC-Fortran-ML, GCC-Patches-ML, everythingfunctional

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

Hi Andre,

I apologise for the slow response. It's been something of a heavy week...

This is good for mainline.

Thanks

Paul

PS That's good news about the funding. Maybe we will get to see "built in"
coarrays soon?


On Tue, 4 Jun 2024 at 11:25, Andre Vehreschild <vehre@gmx.de> wrote:

> Hi all,
>
> attached patch fixes a memory leak when a user-defined function returns a
> polymorphic type/class. The issue was, that the polymorphic type was not
> detected correctly and therefore the len-field was not transferred
> correctly.
>
> Regtests ok x86_64-linux/Fedora 39. Ok for master?
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak
  2024-06-07  6:46 ` Paul Richard Thomas
@ 2024-06-07  8:17   ` Andre Vehreschild
  2024-06-08 19:52     ` Tobias Burnus
  0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2024-06-07  8:17 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: GCC-Fortran-ML, GCC-Patches-ML, everythingfunctional

Hi Paul,

thank you for the review. No need to apologize. I am happily working on and will
ping if I get no reviews.

Btw, Mikael, Nikolas and I are covered by the same funding and agreed to not
review each others work to prevent any "smells", like "they follow there own
agenda". We can of course be triggered by the community to do a second review
of each others work, when no one has enough expertise in the area worked on.

The patch has been commited to master as gcc-15-1090-g51046e46ae6

> 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.

Thanks again for the review.

Regards,
	Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak
  2024-06-07  8:17   ` Andre Vehreschild
@ 2024-06-08 19:52     ` Tobias Burnus
  2024-06-10  7:30       ` Andre Vehreschild
  0 siblings, 1 reply; 5+ messages in thread
From: Tobias Burnus @ 2024-06-08 19:52 UTC (permalink / raw)
  To: Andre Vehreschild, Paul Richard Thomas
  Cc: GCC-Fortran-ML, GCC-Patches-ML, everythingfunctional, Tobias Burnus


[-- Attachment #1.1: Type: text/plain, Size: 1420 bytes --]

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.

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

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.  */
 

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak
  2024-06-08 19:52     ` Tobias Burnus
@ 2024-06-10  7:30       ` Andre Vehreschild
  0 siblings, 0 replies; 5+ messages in thread
From: Andre Vehreschild @ 2024-06-10  7:30 UTC (permalink / raw)
  To: Tobias Burnus
  Cc: Paul Richard Thomas, GCC-Fortran-ML, GCC-Patches-ML,
	everythingfunctional, Tobias Burnus

Hi Tobias,

I know about PRIF and was involved in the design of Caffeine. Unfortunately did
this intersect with the funding proposal and we did not want to overload the
proposal more. At the moment adding module support to dist. mem. coarrays means
OpenCoarrays patching, yes. In the unlikely event, that this should proceed
faster than expected we might look into PRIF/Caffeine and work on an
alternative implementation. But I expect that besides a proof of concept not
much will come of that, because one needs to implement a rather different
interface for each API call. 

Anyway, did you see my question about me issue with doing gomp-fortran tests: 
https://gcc.gnu.org/pipermail/fortran/2024-June/060542.html

Do you have any insight of what I am doing wrong? 

Regards,
	Andre

On Sat, 8 Jun 2024 21:52:42 +0200
Tobias Burnus <burnus@net-b.de> wrote:

> 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.


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

^ permalink raw reply	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2024-06-10  7:31 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-06-04 10:24 [Patch, PR Fortran/90072] Polymorphic Dispatch to Polymophic Return Type Memory Leak Andre Vehreschild
2024-06-07  6:46 ` Paul Richard Thomas
2024-06-07  8:17   ` Andre Vehreschild
2024-06-08 19:52     ` Tobias Burnus
2024-06-10  7:30       ` Andre Vehreschild

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).