Re: *PING* [PATCH v3 10/10] fortran: Add -finline-intrinsics flag for MINLOC/MAXLOC [PR90608]

2024-09-19 Thread Joseph Myers
On Fri, 13 Sep 2024, Mikael Morin wrote:

> *PING*
> 
> Joseph, could you take a quick look at the handling of the new option?
> 
> https://gcc.gnu.org/pipermail/gcc-patches/2024-August/661267.html

Individual new options like this are expected to be reviewed by 
maintainers / reviewers for the relevant part of the compiler, not for 
option handling which is more for the generic machinery independent of 
individual options.

-- 
Joseph S. Myers
josmy...@redhat.com



Re: [patch, fortran] Implement IANY, IALL and IPARITY for unsigned

2024-09-19 Thread Jerry D

On 9/18/24 1:20 PM, Thomas Koenig wrote:

OK for trunk?


OK and thanks.

Jerry
--- snip ---


Re: Re: *PING* [PATCH v3 10/10] fortran: Add -finline-intrinsics flag for MINLOC/MAXLOC [PR90608]

2024-09-19 Thread Jakub Jelinek
On Mon, Sep 16, 2024 at 10:52:43AM +0200, Mikael Morin wrote:
> > While I understand the intent of 'positive form' vs 'negative form', the
> > above might be clearer as
> > 
> > Usage of intrinsics can be implemented either by generating a call
> > to the libgfortran library function or by directly generating inline
> > code.  For most intrinsics, only a single variant is available, and
> > there is no choice of implementation.  However, some intrinsics can
> > use a library function or inline code, wher inline code typically offers
> > opportunities for additional optimization over a library function.
> > With @code{-finline-intrinsics=...} or 
> > @code{-fno-inline-intrinsics=...}, the
> > choice applies only to the intrinsics present in the comma-separated 
> > list
> > provided as argument.
> > 
> > > > +For each intrinsic, if no choice of implementation was made through 
> > > > either of
> > > > +the flag variants, a default behaviour is chosen depending on 
> > > > optimization:
> > > > +library calls are generated when not optimizing or when optimizing for 
> > > > size;
> > > > +otherwise inline code is preferred.
> > > > +
> > 
> > 
> > OK with consideration the above comments.
> > 
> 
> Harald actually gave a partial green light on this already, but obviously
> there was still room for improvement.
> Thanks for the review, I'm incorporating the changes you suggested.
> 
> I was (and still am) waiting for a review from someone knowledgeable in the
> options system.  I'm considering proceeding without, as I prefer seeing this
> pushed sooner than later.

Just note lang.opt.urls will need to be updated, either you do it right away
with make regenerate-opt-urls or commit, wait for a nag-mail from CI and
commit incrementally the patch it creates.

Jakub



[Patch] OpenMP: Add get_device_from_uid/omp_get_uid_from_device routines

2024-09-19 Thread Tobias Burnus

Hi all,

in order to know and potentially re-use a specific offload device 
(reproducibility,
affinity wise close to a CPU (socket), …) a mapping between an (universal?) 
unique
identifier and the OpenMP device number is useful. Thus, TR13 added support for 
it.

This is a collateral patch caused by looking at the API routines for other 
reasons
and looking at that part of the spec during the OpenMP F2F.

Besides the added API routines, the UID will be used elsewhere:
* In context selectors: 'target_device' supports 'uid()'.
* In the OMP_AVAILABLE_DEVICES and OMP_DEFAULT_DEVICE env vars.

@Sandra: Besides the usual .texi part, for the 'target_device' trait set:
if you add a new GOMP routine for kind/arch/isa - can you also add an
UID argument such that we don't have to update the API when needing in the
not so far future.

@Andrew + @Thomas: Any comment? Especially to the nvptx/gcn side (plugin +
.texi)?

@Jakub or anyone else — any comments, suggestions, remarks?

[The patch was tested without GPUs, with one Nvidia GPU and one AMD GPU
and seems to work fine.]

Tobias
OpenMP: Add get_device_from_uid/omp_get_uid_from_device routines

Those TR13/OpenMP 6.0 routines permit a reproducible offloading to
a specific device by mapping an OpenMP device number to a
unique ID (UID). The GPU device UIDs should be universally unique,
the one for the host is not.

gcc/ChangeLog:

	* omp-general.cc (omp_runtime_api_procname): Add
	get_device_from_uid and omp_get_uid_from_device routines.

include/ChangeLog:

	* cuda/cuda.h (cuDeviceGetUuid): Declare.
	(cuDeviceGetUuid_v2): Add prototype.

libgomp/ChangeLog:

	* config/gcn/target.c (omp_get_uid_from_device,
	omp_get_device_from_uid): Add stub implementation.
	* config/nvptx/target.c (omp_get_uid_from_device,
	omp_get_device_from_uid): Likewise.
	* fortran.c (omp_get_uid_from_device_,
	omp_get_uid_from_device_8_): Add.
	* libgomp-plugin.h (GOMP_OFFLOAD_get_uid): Add prototype.
	* libgomp.h (struct gomp_device_descr): Add 'uid' and 'get_uid_func'.
	* libgomp.map (GOMP_6.0): New, includind the new UID routines.
	* libgomp.texi (OpenMP Technical Report 13): Mark UID routines as 'Y'.
	(Device Information Routines): Document new UID routines.
	(Offload-Target Specifics): Document UID format.
	* omp.h.in (omp_get_device_from_uid, omp_get_uid_from_device):
	New prototype.
	* omp_lib.f90.in (omp_get_device_from_uid, omp_get_uid_from_device):
	New interface.
	* omp_lib.h.in: Likewise.
	* plugin/cuda-lib.def: Add cuDeviceGetUuid and cuDeviceGetUuid_v2 via
	CUDA_ONE_CALL_MAYBE_NULL.
	* plugin/plugin-gcn.c (GOMP_OFFLOAD_get_uid): New.
	* plugin/plugin-nvptx.c (GOMP_OFFLOAD_get_uid): New.
	* target.c (str_omp_initial_device): New static var.
	(STR_OMP_DEV_PREFIX): Define.
	(gomp_get_uid_for_device, omp_get_uid_from_device,
	omp_get_device_from_uid): New.
	(gomp_load_plugin_for_device): DLSYM_OPT the function 'get_uid'.
	(gomp_target_init): Set the device's 'uid' field to NULL.
	* testsuite/libgomp.c/device_uid.c: New test.
	* testsuite/libgomp.fortran/device_uid.f90: New test.

 gcc/omp-general.cc   |  4 +-
 include/cuda/cuda.h  |  7 ++
 libgomp/config/gcn/target.c  | 14 
 libgomp/config/nvptx/target.c| 14 
 libgomp/fortran.c| 15 +
 libgomp/libgomp-plugin.h |  1 +
 libgomp/libgomp.h|  2 +
 libgomp/libgomp.map  |  8 +++
 libgomp/libgomp.texi | 81 +++-
 libgomp/omp.h.in |  3 +
 libgomp/omp_lib.f90.in   | 23 +++
 libgomp/omp_lib.h.in | 23 +++
 libgomp/plugin/cuda-lib.def  |  2 +
 libgomp/plugin/plugin-gcn.c  | 16 +
 libgomp/plugin/plugin-nvptx.c| 34 ++
 libgomp/target.c | 56 
 libgomp/testsuite/libgomp.c/device_uid.c | 38 +++
 libgomp/testsuite/libgomp.fortran/device_uid.f90 | 42 
 18 files changed, 379 insertions(+), 4 deletions(-)

diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index de91ba8a4a7..12788ad0249 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3260,6 +3260,7 @@ omp_runtime_api_procname (const char *name)
   "alloc",
   "calloc",
   "free",
+  "get_device_from_uid",
   "get_interop_int",
   "get_interop_ptr",
   "get_mapped_ptr",
@@ -3338,12 +3339,13 @@ omp_runtime_api_procname (const char *name)
 	 as DECL_NAME only omp_* and omp_*_8 appear.  */
   "display_env",
   "get_ancestor_thread_num",
-  "init_allocator",
+  "omp_get_uid_from_device",
   "get_partition_place_nums",
   "get_place_num_procs",
   "get_place_proc_ids",
   "get_schedule",
   "get_team_size",
+  "init_allocator",

Re: [patch, fortran] Add random numbers and fix some bugs.

2024-09-19 Thread Andre Vehreschild
Hi Thomas,

submitting your patch as part of the mail got it corrupted by some mailer
adding line breaks. It does not apply for me. Because I can't test it, I have
more questions, see below:

On Wed, 18 Sep 2024 22:22:15 +0200
Thomas Koenig  wrote:

> This patch adds random number support for UNSIGNED, plus fixes
> two bugs, with array I/O where the type used to be set to BT_INTEGER,
> and for division with the divisor being a constant.
>
> Again, depends on prevous submissions.
>
> OK for trunk?
>
> gcc/fortran/ChangeLog:
>
>   * check.cc (gfc_check_random_number): Adjust for unsigned.
>   * iresolve.cc (gfc_resolve_random_number): Handle unsinged.

Hihi, I do this typo, too, over and over again: s/unsinged/unsigned/

>   * trans-expr.cc (gfc_conv_expr_op): Handle BT_UNSIGNED for divide.
>   * trans-types.cc (gfc_get_dtype_rank_type): Handle BT_UNSIGNED.
>   * gfortran.texi: Add RANDOM_NUMBER for UNSIGNED.
>



> diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
> index 533c9d7d343..1851cfb8d4a 100644
> --- a/gcc/fortran/check.cc
> +++ b/gcc/fortran/check.cc
> @@ -7007,8 +7007,14 @@ gfc_check_random_init (gfc_expr *repeatable,
> gfc_expr *image_distinct)
>   bool
>   gfc_check_random_number (gfc_expr *harvest)
>   {
> -  if (!type_check (harvest, 0, BT_REAL))
> -return false;
> +  if (flag_unsigned)
> +{
> +  if (!type_check2 (harvest, 0, BT_REAL, BT_UNSIGNED))
> + return false;

When the second argument is a BT_INTEGER, does this fail here?

> +}
> +  else
> +if (!type_check (harvest, 0, BT_REAL))
> +  return false;
>
> if (!variable_check (harvest, 0, false))
>   return false;



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


Re: [Fortran, Patch, PR106606, v1] Fortran: Break recursion building recursive types. [PR106606]

2024-09-19 Thread Andre Vehreschild
Hi Thomas,

thanks for review. Committed with the changes requested as:
gcc-15-3711-gde915fbe3cb

Thanks again.

Regards,
Andre

On Wed, 18 Sep 2024 18:24:19 +0200
Thomas Koenig  wrote:

> Hi Andre,
>
> > Regtested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
>
> Extremely minor nit: In the commit message and ChangeLog entry,
>
> Build a derived type component's type only, when it is not already being
> build and the component uses pointer semantics.
>
> I believe that should be "being built".
>
> In the ChangeLog entry
>
>   derived types as component's types when they are not yet build.
>
> s/build/built/
>
> OK for trunk.
>
> Thanks for the patch!
>
> Best regards
>
>   Thomas
>
>


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


Re: [Patch] OpenMP: Add get_device_from_uid/omp_get_uid_from_device routines

2024-09-19 Thread Andre Vehreschild
Hi Tobias,

in the changelog of libgomp:

* fortran.c (omp_get_uid_from_device_,
omp_get_uid_from_device_8_): Add.

"Add." what? Can you be more specific, i.e. is it just a dummy or prototype?

In the libgomp/libgomp.texi

+@node omp_get_uid_from_device
+@subsection @code{omp_get_uid_from_device} -- Obtain the unique id of a device
+@table @asis
+@item @emph{Description}:
+This function returns a pointer to _a_ string that represents a unique
identifier 
^^^

+(UID) for the device specified by @var{device_num}.  It returns a ...



@@ -6604,6 +6673,12 @@ The implementation remark:
   @code{omp_thread_mem_alloc}, all use low-latency memory as first
   preference, and fall back to main graphics memory when the low-latency
   pool is exhausted.
+@item The unique identifier (UID), used with OpenMP's API UID routine, consists
+  of the @samp{GPU-} prefix followed by the 16-bytes UUID as returned by
+  the CUDA runtime library.  This UUID is output in grouped lower-case
+  hex digits; the grouping of those 32 digits is: 8 digits, hyphen,
+  4 digits, hyphen, 4 digits, hyphen, 16 digits.  The output matches the
+  format used by @code{nvidia-smi}.
 @end itemize

Do I get this right, that for CUDA this is, e.g. GPU-0123456789abdcef ? Then
why is the "normal" UUID display format described here? This confuses me. (Just
curiosity.)

Er, and when I read further on, I find the nvptx implementation and that
contradicts the description. There a "normal" UUID is added to the GPU- id. So
you might want to make that implementation remark more clear

Sorry for the bickering. I just stumbled over that while waiting for a
regression test.

The remainder looks reasonable to me.

Regards,
Andre

On Thu, 19 Sep 2024 15:23:54 +0200
Tobias Burnus  wrote:

> Hi all,
> 
> in order to know and potentially re-use a specific offload device
> (reproducibility, affinity wise close to a CPU (socket), …) a mapping between
> an (universal?) unique identifier and the OpenMP device number is useful.
> Thus, TR13 added support for it.
> 
> This is a collateral patch caused by looking at the API routines for other
> reasons and looking at that part of the spec during the OpenMP F2F.
> 
> Besides the added API routines, the UID will be used elsewhere:
> * In context selectors: 'target_device' supports 'uid()'.
> * In the OMP_AVAILABLE_DEVICES and OMP_DEFAULT_DEVICE env vars.
> 
> @Sandra: Besides the usual .texi part, for the 'target_device' trait set:
> if you add a new GOMP routine for kind/arch/isa - can you also add an
> UID argument such that we don't have to update the API when needing in the
> not so far future.
> 
> @Andrew + @Thomas: Any comment? Especially to the nvptx/gcn side (plugin +
> .texi)?
> 
> @Jakub or anyone else — any comments, suggestions, remarks?
> 
> [The patch was tested without GPUs, with one Nvidia GPU and one AMD GPU
> and seems to work fine.]
> 
> Tobias


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


[Fortran, Patch, PR84870, v1] Fix ICE and allocated memory not assigned correctly.

2024-09-19 Thread Andre Vehreschild
Hi all,

in PR84870 an ICE was reported, that has been fixed in the meantime by some
other patch. Nevertheless did a testcase reveal that the memory handling still
was not correct. I.e. the test case in the patch was answering 2 for both x.b.a
and y.b.a which is not correct.

For a coarray all memory is allocated using an array descriptor. For scalars
just a temporary descriptor is created and handed to the caf-register routine.
The error here was, that the memory now handed back in the temporary descriptor
was not used for the memory in the component, thus the pointer in the component
was not updated. The patch fixes this.

Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?

Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From c26e97a8196fc26abf36a0bad6ffd6f9da7ba5d8 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild 
Date: Thu, 19 Sep 2024 15:09:52 +0200
Subject: [PATCH] Fortran: Assign allocated caf-memory to scalar members
 [PR84870]

Allocating a coarray required an array-descriptor.  For scalars a
temporary descriptor was created.  Assigning the allocated memory from
the temporary descriptor back to the scalar is now added.

gcc/fortran/ChangeLog:

	PR fortran/84870

	* trans-array.cc (duplicate_allocatable_coarray): For scalar
	allocatable components the memory allocated is now assigned to
	the component's pointer.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/alloc_comp_10.f90: New test.
---
 gcc/fortran/trans-array.cc|  2 ++
 .../gfortran.dg/coarray/alloc_comp_10.f90 | 24 +++
 2 files changed, 26 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 838b6d3da80..3da7479fd10 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9451,6 +9451,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type,
   gfc_build_addr_expr (NULL_TREE, dest_tok),
   NULL_TREE, NULL_TREE, NULL_TREE,
   GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+  gfc_add_modify (&block, dest, gfc_conv_descriptor_data_get (dummy_desc));
   null_data = gfc_finish_block (&block);

   gfc_init_block (&block);
@@ -9460,6 +9461,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type,
   gfc_build_addr_expr (NULL_TREE, dest_tok),
   NULL_TREE, NULL_TREE, NULL_TREE,
   GFC_CAF_COARRAY_ALLOC);
+  gfc_add_modify (&block, dest, gfc_conv_descriptor_data_get (dummy_desc));

   tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
   tmp = build_call_expr_loc (input_location, tmp, 3, dest, src,
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90
new file mode 100644
index 000..a31d005498c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90
@@ -0,0 +1,24 @@
+!{ dg-do run }
+
+! Check that copying of memory for allocated scalar is assigned
+! to coarray object.
+
+! Contributed by G. Steinmetz  
+
+program p
+  type t
+integer, allocatable :: a
+  end type
+  type t2
+type(t), allocatable :: b
+  end type
+  type(t2) :: x, y[*]
+
+  x%b = t(1)
+  y = x
+  y%b%a = 2
+
+  if (x%b%a /= 1) stop 1
+  if (y%b%a /= 2) stop 2
+end
+
--
2.46.0



Re: [Patch, Fortran] Implement Unsigned for SUM and PRODUCT

2024-09-19 Thread Andre Vehreschild
Hi Thomas,

thanks for the patch. I have one proposal/question and one missing verb (IMO).
Else the patch looks fine to me. Ok for trunk.

> diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
> index 829ab00c665..e5ffe67 100644
> --- a/gcc/fortran/gfortran.texi
> +++ b/gcc/fortran/gfortran.texi
> @@ -2788,7 +2788,7 @@ As of now, the following intrinsics take unsigned
> arguments: @item @code{MVBITS}
>  @item @code{RANGE}
>  @item @code{TRANSFER}
> -@item @code{MATMUL} and @code{DOT_PRODUCT}
> +@item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}

How about sorting those alphabetically and putting each on a separate line?
This might make it more viewable. Just a suggestion.

>  @end itemize
>  This list will grow in the near future.
>  @c -
> diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
> index 32b31432e58..92a591cf6d7 100644
> --- a/gcc/fortran/iresolve.cc
> +++ b/gcc/fortran/iresolve.cc
> @@ -175,9 +175,11 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr
> *dim, gfc_expr *kind,
>  static void
>  resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
> -   gfc_expr *dim, gfc_expr *mask)
> +   gfc_expr *dim, gfc_expr *mask,
> +   bool use_integer = false)
>  {
>const char *prefix;
> +  bt type;
>
>f->ts = array->ts;
>
> @@ -200,9 +202,18 @@ resolve_transformational (const char *name, gfc_expr *f,
> gfc_expr *array, gfc_resolve_dim_arg (dim);
>  }
>
> +  /* For those intrinsic like SUM where we the integer version

There is a verb missing here, IMO. ... where we _use_ the ... ???

> + actually uses unsigned, but we call it as the integer
> + version.  */
> +
> +  if (use_integer && array->ts.type == BT_UNSIGNED)
> +type = BT_INTEGER;
> +  else
> +type = array->ts.type;
> +
>f->value.function.name
>  = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
> -   gfc_type_letter (array->ts.type),
> +   gfc_type_letter (type),
> gfc_type_abi_kind (&array->ts));
>  }
>

Regards and thanks for the patch,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de


Re: [patch, fortran] Implement IANY, IALL and IPARITY for unsigned

2024-09-19 Thread Andre Vehreschild
Hi Thomas,

this look fine to. Ok for trunk.

Thanks for the patch,
Andre

On Wed, 18 Sep 2024 22:20:44 +0200
Thomas Koenig  wrote:

> OK for trunk?
>
> This is based on the previous submissions. Again, this does not
> generate a new library version; rather it re-uses the signed
> integer version already present in the library.
>
> OK for trunk?
>
> Previous submissions (without which this will not work):
>
> https://gcc.gnu.org/pipermail/fortran/2024-September/060975.html
> https://gcc.gnu.org/pipermail/fortran/2024-September/060987.html
>
> gcc/fortran/ChangeLog:
>
>   * check.cc (gfc_check_transf_bit_intrins): Handle unsigned.
>   * gfortran.texi: Docment IANY, IALL and IPARITY for unsigned.
>   * iresolve.cc (gfc_resolve_iall): Set flag to use integer
>   if type is BT_UNSIGNED.
>   (gfc_resolve_iany): Likewise.
>   (gfc_resolve_iparity): Likewise.
>   * simplify.cc (do_bit_and): Adjust asserts for BT_UNSIGNED.
>   (do_bit_ior): Likewise.
>   (do_bit_xor): Likewise
>
> gcc/testsuite/ChangeLog:
>
>   * gfortran.dg/unsigned_29.f90: New test.
>
>   gcc/fortran/check.cc  | 14 ++-
>   gcc/fortran/gfortran.texi |  1 +
>   gcc/fortran/iresolve.cc   |  6 +--
>   gcc/fortran/simplify.cc   | 51 +++
>   gcc/testsuite/gfortran.dg/unsigned_29.f90 | 40 ++
>   5 files changed, 99 insertions(+), 13 deletions(-)
>   create mode 100644 gcc/testsuite/gfortran.dg/unsigned_29.f90
>
> diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
> index 7c630dd73f4..533c9d7d343 100644
> --- a/gcc/fortran/check.cc
> +++ b/gcc/fortran/check.cc
> @@ -4430,7 +4430,19 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind)
>   bool
>   gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
>   {
> -  if (ap->expr->ts.type != BT_INTEGER)
> +  bt type = ap->expr->ts.type;
> +
> +  if (flag_unsigned)
> +{
> +  if (type != BT_INTEGER && type != BT_UNSIGNED)
> + {
> +   gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
> +  "or UNSIGNED", gfc_current_intrinsic_arg[0]->name,
> +  gfc_current_intrinsic, &ap->expr->where);
> +   return false;
> + }
> +}
> +  else if (ap->expr->ts.type != BT_INTEGER)
>   {
> gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER",
>gfc_current_intrinsic_arg[0]->name,
> diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
> index e5ffe67..3eb8039c09f 100644
> --- a/gcc/fortran/gfortran.texi
> +++ b/gcc/fortran/gfortran.texi
> @@ -2789,6 +2789,7 @@ As of now, the following intrinsics take unsigned
> arguments:
>   @item @code{RANGE}
>   @item @code{TRANSFER}
>   @item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}
> +@item @code{IANY}, @code{IALL} and @code{IPARITY}
>   @end itemize
>   This list will grow in the near future.
>   @c -
> diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
> index 92a591cf6d7..58a1821ef10 100644
> --- a/gcc/fortran/iresolve.cc
> +++ b/gcc/fortran/iresolve.cc
> @@ -1195,7 +1195,7 @@ gfc_resolve_hypot (gfc_expr *f, gfc_expr *x,
> gfc_expr *y ATTRIBUTE_UNUSED)
>   void
>   gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
> gfc_expr *mask)
>   {
> -  resolve_transformational ("iall", f, array, dim, mask);
> +  resolve_transformational ("iall", f, array, dim, mask, true);
>   }
>
>
> @@ -1223,7 +1223,7 @@ gfc_resolve_iand (gfc_expr *f, gfc_expr *i,
> gfc_expr *j)
>   void
>   gfc_resolve_iany (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
> gfc_expr *mask)
>   {
> -  resolve_transformational ("iany", f, array, dim, mask);
> +  resolve_transformational ("iany", f, array, dim, mask, true);
>   }
>
>
> @@ -1429,7 +1429,7 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a)
>   void
>   gfc_resolve_iparity (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
> gfc_expr *mask)
>   {
> -  resolve_transformational ("iparity", f, array, dim, mask);
> +  resolve_transformational ("iparity", f, array, dim, mask, true);
>   }
>
>
> diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
> index e5681c42a48..bd2f6485c95 100644
> --- a/gcc/fortran/simplify.cc
> +++ b/gcc/fortran/simplify.cc
> @@ -3401,9 +3401,20 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
>   static gfc_expr *
>   do_bit_and (gfc_expr *result, gfc_expr *e)
>   {
> -  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
> -  gcc_assert (result->ts.type == BT_INTEGER
> -   && result->expr_type == EXPR_CONSTANT);
> +  if (flag_unsigned)
> +{
> +  gcc_assert ((e->ts.type == BT_INTEGER || e->ts.type == BT_UNSIGNED)
> +   && e->expr_type == EXPR_CONSTANT);
> +  gcc_assert ((result->ts.type == BT_INTEGER
> +|| result->ts.type == BT_UNSIGNED)
> +   && result->expr_type == E

Re: [Ping, Fortran, Patch, PR85002, v1] Fix deep-copy of alloc. comps. in coarrays ICEing and crashing w/ lib.

2024-09-19 Thread Andre Vehreschild
Hi Thomas,

comitted as gcc-15-3707-g361903ad1af.

Thanks for the review. I am reviewing your unsigned work at the moment.

Thanks again and regards,
Andre

On Wed, 18 Sep 2024 18:18:20 +0200
Thomas Koenig  wrote:

> Am 18.09.24 um 12:31 schrieb Andre Vehreschild:
> > Regtested ok on x86_64-pc-linux-gnu / F39. Ok for mainline?
>
> OK.
>
> Thanks for the patch!
>
> Best regards
>
>   Thomas


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


Re: [Patch] OpenMP: Add get_device_from_uid/omp_get_uid_from_device routines

2024-09-19 Thread Tobias Burnus

Hi Andre,

thanks for reading the patch + commenting.

Andre Vehreschild wrote:

in the changelog of libgomp:

* fortran.c (omp_get_uid_from_device_,
omp_get_uid_from_device_8_): Add.

"Add." what? Can you be more specific, i.e. is it just a dummy or prototype?


Neither. It is a full implementation (that is a wrapper to the target.c 
function, directly called by C/C++).


The prototype used by fortran.c is 'omp.h.in' (i.e. the C/C++ header 
file, also used by user code) and for Fortran code of users, it is the 
module generated from 'omp_lib.f90.in' and the (deprecated) include file 
'omp_lib.h.in'.


The purpose of fortran.c in general – and also for the added code – is 
to be a wrapper between the Fortran API/ABI and the C ABI. In the 
current case, there are two reasons for the two functions:


(a) The result type is 'character(:), pointer' – but the C function just 
returns a '\0' terminated const char*. Hence, the wrapper function 
contains a '*result_len = strlen (*result);' besides the '*result = 
'


(b) The argument is an 'integer'. As we want to be compatible with 
-fdefault-integer-8, previously somewhat fashionable, we have an 
'int32_t' and an 'int64_t' version of the function – which needs a 
second wrapper function.


As for the other API routine, as a BIND(C) makes it call the C function, 
no wrapper it needed.


* * *

[Typo: missing 'a' – noted + will fix.]

* * *


+@item The unique identifier (UID), used with OpenMP's API UID routine, consists
+  of the @samp{GPU-} prefix followed by the 16-bytes UUID as returned by
+  the CUDA runtime library.  This UUID is output in grouped lower-case
+  hex digits; the grouping of those 32 digits is: 8 digits, hyphen,
+  4 digits, hyphen, 4 digits, hyphen, 16 digits.  The output matches the
+  format used by @code{nvidia-smi}.
  @end itemize

Do I get this right, that for CUDA this is, e.g. GPU-0123456789abdcef ? Then
why is the "normal" UUID display format described here? This confuses me. (Just
curiosity.)


For AMD, it is the following type of string, which contains a 8 bytes/16 
hex-digits UUID part: 'GPU-abcef0123456789'.


While for Nvidia it is 'GPU-abcdef12-1234-1234-01234567890abcd', 
consisting of a 16 bytes/32 hex-digits UUID.


For AMD, we directly get the string, matching what "rocminfo" shows as UUID.

For Nvidia, we don't get a string but a 'char bytes[16]' array filled 
with the values, which we print each as '%02x' hex digit. For the 
output, additionally, a "GPU-" prefix is added + a few hyphens. That's 
to mimic what 'nvidia-smi -a' outputs.


I admit it is slightly confusing – and when reading the .texi, it is 
also easy to miss that one part talks about AMD ("GCN") GPUs and the 
other about NVidia GPUs.


→ https://gcc.gnu.org/onlinedocs/libgomp/Offload-Target-Specifics.html

(In terms of OpenMP, it is only a unique identifier; it does not need to 
be universally unique [and also isn't for the host]; AMD and Nvidia call 
it UUID and it looks rather unique for the GPU; rocminfo also outputs an 
"UUID" for the CPU but that's just "CPU-XX" (twice for a dual socket 
system, i.e. not even unique), but we don't use this output.)



Er, and when I read further on, I find the nvptx implementation and that
contradicts the description. There a "normal" UUID is added to the GPU- id.


Now I am confused. What description contradicts which one?

Tobias

[Patch][v2] OpenMP: Add get_device_from_uid/omp_get_uid_from_device routines

2024-09-19 Thread Tobias Burnus

Minor update – addressing the issues that Andre raised (thanks!):

'Add.' → 'New functions.' in the ChangeLog for 'fortran.c' and otherwise 
libgomp.texi changes, only:


A bunch of typo fixes (preexisting and in the new text). I also added an 
made-up example UUID for the GPUs, which should help to reduce confusion.


Any additional comments or suggestions?

Tobias

Tobias Burnus wrote:
in order to know and potentially re-use a specific offload device 
(reproducibility,
affinity wise close to a CPU (socket), …) a mapping between an 
(universal?) unique
identifier and the OpenMP device number is useful. Thus, TR13 added 
support for it.


This is a collateral patch caused by looking at the API routines for 
other reasons

and looking at that part of the spec during the OpenMP F2F.

Besides the added API routines, the UID will be used elsewhere:
* In context selectors: 'target_device' supports 'uid()'.
* In the OMP_AVAILABLE_DEVICES and OMP_DEFAULT_DEVICE env vars.

@Sandra: Besides the usual .texi part, for the 'target_device' trait set:
if you add a new GOMP routine for kind/arch/isa - can you also add an
UID argument such that we don't have to update the API when needing in 
the

not so far future.

@Andrew + @Thomas: Any comment? Especially to the nvptx/gcn side 
(plugin +

.texi)?

@Jakub or anyone else — any comments, suggestions, remarks?

[The patch was tested without GPUs, with one Nvidia GPU and one AMD GPU
and seems to work fine.]OpenMP: Add get_device_from_uid/omp_get_uid_from_device routines

Those TR13/OpenMP 6.0 routines permit a reproducible offloading to
a specific device by mapping an OpenMP device number to a
unique ID (UID). The GPU device UIDs should be universally unique,
the one for the host is not.

gcc/ChangeLog:

	* omp-general.cc (omp_runtime_api_procname): Add
	get_device_from_uid and omp_get_uid_from_device routines.

include/ChangeLog:

	* cuda/cuda.h (cuDeviceGetUuid): Declare.
	(cuDeviceGetUuid_v2): Add prototype.

libgomp/ChangeLog:

	* config/gcn/target.c (omp_get_uid_from_device,
	omp_get_device_from_uid): Add stub implementation.
	* config/nvptx/target.c (omp_get_uid_from_device,
	omp_get_device_from_uid): Likewise.
	* fortran.c (omp_get_uid_from_device_,
	omp_get_uid_from_device_8_): New functions.
	* libgomp-plugin.h (GOMP_OFFLOAD_get_uid): Add prototype.
	* libgomp.h (struct gomp_device_descr): Add 'uid' and 'get_uid_func'.
	* libgomp.map (GOMP_6.0): New, includind the new UID routines.
	* libgomp.texi (OpenMP Technical Report 13): Mark UID routines as 'Y'.
	(Device Information Routines): Document new UID routines.
	(Offload-Target Specifics): Document UID format.
	* omp.h.in (omp_get_device_from_uid, omp_get_uid_from_device):
	New prototype.
	* omp_lib.f90.in (omp_get_device_from_uid, omp_get_uid_from_device):
	New interface.
	* omp_lib.h.in: Likewise.
	* plugin/cuda-lib.def: Add cuDeviceGetUuid and cuDeviceGetUuid_v2 via
	CUDA_ONE_CALL_MAYBE_NULL.
	* plugin/plugin-gcn.c (GOMP_OFFLOAD_get_uid): New.
	* plugin/plugin-nvptx.c (GOMP_OFFLOAD_get_uid): New.
	* target.c (str_omp_initial_device): New static var.
	(STR_OMP_DEV_PREFIX): Define.
	(gomp_get_uid_for_device, omp_get_uid_from_device,
	omp_get_device_from_uid): New.
	(gomp_load_plugin_for_device): DLSYM_OPT the function 'get_uid'.
	(gomp_target_init): Set the device's 'uid' field to NULL.
	* testsuite/libgomp.c/device_uid.c: New test.
	* testsuite/libgomp.fortran/device_uid.f90: New test.

 gcc/omp-general.cc   |  4 +-
 include/cuda/cuda.h  |  7 ++
 libgomp/config/gcn/target.c  | 14 
 libgomp/config/nvptx/target.c| 14 
 libgomp/fortran.c| 15 
 libgomp/libgomp-plugin.h |  1 +
 libgomp/libgomp.h|  2 +
 libgomp/libgomp.map  |  8 +++
 libgomp/libgomp.texi | 89 ++--
 libgomp/omp.h.in |  3 +
 libgomp/omp_lib.f90.in   | 23 ++
 libgomp/omp_lib.h.in | 23 ++
 libgomp/plugin/cuda-lib.def  |  2 +
 libgomp/plugin/plugin-gcn.c  | 16 +
 libgomp/plugin/plugin-nvptx.c| 34 +
 libgomp/target.c | 56 +++
 libgomp/testsuite/libgomp.c/device_uid.c | 38 ++
 libgomp/testsuite/libgomp.fortran/device_uid.f90 | 42 +++
 18 files changed, 384 insertions(+), 7 deletions(-)

diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index de91ba8a4a7..12788ad0249 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3260,6 +3260,7 @@ omp_runtime_api_procname (const char *name)
   "alloc",
   "calloc",
   "free",
+  "get_device_from_uid",
   "get_interop_int",
   "get_interop_ptr",
   "get_mapped_ptr",
@@ -3338,12 +3339,13 @

Re: [patch, fortran] Matmul and dot_product for unsigned

2024-09-19 Thread Thomas Koenig

Hi Andre,


diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 66a3635404a..a214b8bc1b3 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -711,17 +711,9 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
  case BT_UNSIGNED:
{
if (pedantic)
- return ARITH_UNSIGNED_NEGATIVE;
+ return check_result (ARITH_UNSIGNED_NEGATIVE, op1, result, resultp);


What is the need for this check? ARITH_UNSIGNED_NEGATIVE is, when I read the
code correctly, never triggering an error here. What do I not see?


check_result is a bit of a misnomer, it actually assigns the result
to resultp, or frees the operand if a hard arithmetic error is
encountered.  I had the same thought you had, but learned abou this
by encountering an ICE :-)



-   arith neg_rc;
mpz_neg (result->value.integer, op1->value.integer);
-   neg_rc = gfc_range_check (result);





diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index cfafdb7974f..7c630dd73f4 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -2804,6 +2804,10 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr
*vector_b) return false;
break;

+case BT_UNSIGNED:
+  /* Check comes later.  */
+  break;
+
  default:
gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
@@ -2811,6 +2815,14 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr
*vector_b) return false;
  }

+  if (gfc_invalid_unsigned_ops (vector_a, vector_b))


I haven't read the proposal (shame to me), but why would want not want to
combine a unsigned vector with a signed one? This all depends on the data type
of the result (variable). So why is this needed here? (I know we don't have the
result available here.) It just feels odd to me.


No, we don't. The check does indeed come later, in the
call to gfc_invalid_unsigned_ops case.  Hence the comment.




+{
+  gfc_error ("Argument types of %qs intrinsic at %L must match (%s/%s)",
+gfc_current_intrinsic, &vector_a->where,
+gfc_typename(&vector_a->ts), gfc_typename(&vector_b->ts));
+   return false;
+}
+
if (!rank_check (vector_a, 0, 1))
  return false;

@@ -4092,7 +4104,8 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr
*matrix_b) }

if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts))
-  || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL))
+  || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL)
+  || gfc_invalid_unsigned_ops (matrix_a, matrix_b))


Same here.


See above.


  {
gfc_error ("Argument types of %qs intrinsic at %L must match (%s/%s)",
 gfc_current_intrinsic, &matrix_a->where,
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 81c641e2322..cef971894ea 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -224,7 +224,19 @@ gfc_get_int_expr (int kind, locus *where, HOST_WIDE_INT
value) return p;
  }

+/* Get a new expression node that is an unsigned constant.  */

+gfc_expr *
+gfc_get_unsigned_expr (int kind, locus *where, HOST_WIDE_INT value)
+{
+  gfc_expr *p;
+  p = gfc_get_constant_expr (BT_UNSIGNED, kind,
+where ? where : &gfc_current_locus);
+  const wide_int w = wi::shwi (value, kind * BITS_PER_UNIT);
+  wi::to_mpz (w, p->value.integer, UNSIGNED);
+
+  return p;
+}


Newline please :-)


OK :-)




  /* Get a new expression node that is a logical constant.  */

  gfc_expr *





diff --git a/libgfortran/m4/iparm.m4 b/libgfortran/m4/iparm.m4
index b474620424b..0c4c76c2428 100644
--- a/libgfortran/m4/iparm.m4
+++ b/libgfortran/m4/iparm.m4
@@ -4,7 +4,7 @@ dnl This file is part of the GNU Fortran 95 Runtime Library
(libgfortran) dnl Distributed under the GNU GPL with exception.  See COPYING
for details. dnl M4 macro file to get type names from filenames
  define(get_typename2, `GFC_$1_$2')dnl
-define(get_typename,
`get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,s,UINTEGER,unknown),`$2')')dnl
+define(get_typename,
`get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,m,UINTEGER,ifelse($1,s,UINTEGER,unknown)),`$2')')dnl


Curiosity killed the cat: So type letter 's' and 'm' both signify a unsigned
integer, right? Is there anywhere a notable difference? I meant, keep it simple
is usually wanted and having to type letters with identical meaning is not
simple, right?


Yep.  This is a case of "do not meddle in the affairs in m4, for it is
subtle and quick to cause weird errors". I wasn't totally sure that
"s" was used nowhere, so I just stuck it on there as an additional
optin.



define(get_arraytype, `gfc_array_$1$2')dnl define(define_type, `dnl
ifelse(regexp($2,`^[0-9]'),-1,`dnl diff --git a/libgfortran/m4/matmul.m4
b/libgfortran/m4/matmul.m4 ind

Re: [Patch, Fortran] Implement Unsigned for SUM and PRODUCT

2024-09-19 Thread Thomas Koenig

Am 19.09.24 um 11:55 schrieb Andre Vehreschild:

Hi Thomas,

thanks for the patch. I have one proposal/question and one missing verb (IMO).
Else the patch looks fine to me. Ok for trunk.


diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 829ab00c665..e5ffe67 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2788,7 +2788,7 @@ As of now, the following intrinsics take unsigned
arguments: @item @code{MVBITS}
  @item @code{RANGE}
  @item @code{TRANSFER}
-@item @code{MATMUL} and @code{DOT_PRODUCT}
+@item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}


How about sorting those alphabetically and putting each on a separate line?
This might make it more viewable. Just a suggestion.


I tried to group them somewhat logically, but you're right, this may be
better.  Eventually, I want to document the UNSIGNED arguments to
all intrinsics so they are in the right place.

I think I will re-sort this after all intrinsics have been finished.



  @end itemize
  This list will grow in the near future.
  @c -
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 32b31432e58..92a591cf6d7 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -175,9 +175,11 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr
*dim, gfc_expr *kind,
  static void
  resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
- gfc_expr *dim, gfc_expr *mask)
+ gfc_expr *dim, gfc_expr *mask,
+ bool use_integer = false)
  {
const char *prefix;
+  bt type;

f->ts = array->ts;

@@ -200,9 +202,18 @@ resolve_transformational (const char *name, gfc_expr *f,
gfc_expr *array, gfc_resolve_dim_arg (dim);
  }

+  /* For those intrinsic like SUM where we the integer version


There is a verb missing here, IMO. ... where we _use_ the ... ???


This sentence no verb, correct :-)


+ actually uses unsigned, but we call it as the integer
+ version.  */
+
+  if (use_integer && array->ts.type == BT_UNSIGNED)
+type = BT_INTEGER;
+  else
+type = array->ts.type;
+
f->value.function.name
  = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
- gfc_type_letter (array->ts.type),
+ gfc_type_letter (type),
  gfc_type_abi_kind (&array->ts));
  }



Regards and thanks for the patch,
Andre


Thanks!

Best regards

Thomas



Re: [patch, fortran] Matmul and dot_product for unsigned

2024-09-19 Thread Andre Vehreschild
Hi Thomas,

unfortunately I have some questions. Most of them are for my understanding.

> diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
> index 66a3635404a..a214b8bc1b3 100644
> --- a/gcc/fortran/arith.cc
> +++ b/gcc/fortran/arith.cc
> @@ -711,17 +711,9 @@ gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
>  case BT_UNSIGNED:
>{
>   if (pedantic)
> -   return ARITH_UNSIGNED_NEGATIVE;
> +   return check_result (ARITH_UNSIGNED_NEGATIVE, op1, result, resultp);

What is the need for this check? ARITH_UNSIGNED_NEGATIVE is, when I read the
code correctly, never triggering an error here. What do I not see?

>
> - arith neg_rc;
>   mpz_neg (result->value.integer, op1->value.integer);
> - neg_rc = gfc_range_check (result);



> diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
> index cfafdb7974f..7c630dd73f4 100644
> --- a/gcc/fortran/check.cc
> +++ b/gcc/fortran/check.cc
> @@ -2804,6 +2804,10 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr
> *vector_b) return false;
>break;
>
> +case BT_UNSIGNED:
> +  /* Check comes later.  */
> +  break;
> +
>  default:
>gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
>"or LOGICAL", gfc_current_intrinsic_arg[0]->name,
> @@ -2811,6 +2815,14 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr
> *vector_b) return false;
>  }
>
> +  if (gfc_invalid_unsigned_ops (vector_a, vector_b))

I haven't read the proposal (shame to me), but why would want not want to
combine a unsigned vector with a signed one? This all depends on the data type
of the result (variable). So why is this needed here? (I know we don't have the
result available here.) It just feels odd to me.

> +{
> +  gfc_error ("Argument types of %qs intrinsic at %L must match (%s/%s)",
> +  gfc_current_intrinsic, &vector_a->where,
> +  gfc_typename(&vector_a->ts), gfc_typename(&vector_b->ts));
> +   return false;
> +}
> +
>if (!rank_check (vector_a, 0, 1))
>  return false;
>
> @@ -4092,7 +4104,8 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr
> *matrix_b) }
>
>if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts))
> -  || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL))
> +  || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL)
> +  || gfc_invalid_unsigned_ops (matrix_a, matrix_b))

Same here.

>  {
>gfc_error ("Argument types of %qs intrinsic at %L must match (%s/%s)",
>gfc_current_intrinsic, &matrix_a->where,
> diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
> index 81c641e2322..cef971894ea 100644
> --- a/gcc/fortran/expr.cc
> +++ b/gcc/fortran/expr.cc
> @@ -224,7 +224,19 @@ gfc_get_int_expr (int kind, locus *where, HOST_WIDE_INT
> value) return p;
>  }
>
> +/* Get a new expression node that is an unsigned constant.  */
>
> +gfc_expr *
> +gfc_get_unsigned_expr (int kind, locus *where, HOST_WIDE_INT value)
> +{
> +  gfc_expr *p;
> +  p = gfc_get_constant_expr (BT_UNSIGNED, kind,
> +  where ? where : &gfc_current_locus);
> +  const wide_int w = wi::shwi (value, kind * BITS_PER_UNIT);
> +  wi::to_mpz (w, p->value.integer, UNSIGNED);
> +
> +  return p;
> +}

Newline please :-)

>  /* Get a new expression node that is a logical constant.  */
>
>  gfc_expr *



> diff --git a/libgfortran/m4/iparm.m4 b/libgfortran/m4/iparm.m4
> index b474620424b..0c4c76c2428 100644
> --- a/libgfortran/m4/iparm.m4
> +++ b/libgfortran/m4/iparm.m4
> @@ -4,7 +4,7 @@ dnl This file is part of the GNU Fortran 95 Runtime Library
> (libgfortran) dnl Distributed under the GNU GPL with exception.  See COPYING
> for details. dnl M4 macro file to get type names from filenames
>  define(get_typename2, `GFC_$1_$2')dnl
> -define(get_typename,
> `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,s,UINTEGER,unknown),`$2')')dnl
> +define(get_typename,
> `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,m,UINTEGER,ifelse($1,s,UINTEGER,unknown)),`$2')')dnl

Curiosity killed the cat: So type letter 's' and 'm' both signify a unsigned
integer, right? Is there anywhere a notable difference? I meant, keep it simple
is usually wanted and having to type letters with identical meaning is not
simple, right?

> define(get_arraytype, `gfc_array_$1$2')dnl define(define_type, `dnl
> ifelse(regexp($2,`^[0-9]'),-1,`dnl diff --git a/libgfortran/m4/matmul.m4
> b/libgfortran/m4/matmul.m4 index 7fc1f5fa75f..cd804e8be06 100644
> --- a/libgfortran/m4/matmul.m4
> +++ b/libgfortran/m4/matmul.m4
> @@ -28,6 +28,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
> If not, see #include '
>
>  include(iparm.m4)dnl
> +ifelse(index(rtype_name,`GFC_INTEGER'),`0',dnl
> +define(`rtype_name',patsubst(rtype_name,`GFC_INTEGER',`GFC_UINTEGER'))dnl
> +define(`rtype',patsubst(

[Fortran, Patch, PR101100, v1] Fix ICE when compiling with caf-lib and using proc_pointer component.

2024-09-19 Thread Andre Vehreschild
Hi all,

the attached patch fixes an ICE when compiling with -fcoarray=lib and using
(proc_-)pointer component in a coarray. The code was looking at the wrong
location for the caf-token.

Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?

Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 5115201ea3eb9caf673adce89c49e953cb46c375 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild 
Date: Wed, 18 Sep 2024 15:55:28 +0200
Subject: [PATCH] Fortran: Allow to nullify caf token when not in ultimate
 component. [PR101100]

gcc/fortran/ChangeLog:

	PR fortran/101100

	* trans-expr.cc (trans_caf_token_assign): Take caf-token from
	decl for non ultimate coarray components.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/proc_pointer_assign_1.f90: New test.
---
 gcc/fortran/trans-expr.cc |  8 -
 .../coarray/proc_pointer_assign_1.f90 | 29 +++
 2 files changed, 36 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 54901c33139..18ef5e246ce 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10371,7 +10371,13 @@ trans_caf_token_assign (gfc_se *lse, gfc_se *rse, gfc_expr *expr1,
   else if (lhs_attr.codimension)
 {
   lhs_tok = gfc_get_ultimate_alloc_ptr_comps_caf_token (lse, expr1);
-  lhs_tok = build_fold_indirect_ref (lhs_tok);
+  if (!lhs_tok)
+	{
+	  lhs_tok = gfc_get_tree_for_caf_expr (expr1);
+	  lhs_tok = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (lhs_tok));
+	}
+  else
+	lhs_tok = build_fold_indirect_ref (lhs_tok);
   tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node,
 			lhs_tok, null_pointer_node);
   gfc_prepend_expr_to_block (&lse->post, tmp);
diff --git a/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90 b/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90
new file mode 100644
index 000..81f0c3b19cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90
@@ -0,0 +1,29 @@
+!{ dg-do run }
+
+! Check that PR101100 is fixed.
+
+! Contributed by G. Steinmetz  
+
+program p
+  type t
+procedure(), pointer, nopass :: f
+  end type
+
+  integer :: i = 0
+  type(t) :: x[*]
+
+  x%f => null()
+  if ( associated(x%f) ) stop 1
+
+  x%f => g
+  if (.not. associated(x%f) ) stop 2
+
+  call x%f()
+  if ( i /= 1 ) stop 3
+
+contains
+  subroutine g()
+i = 1
+  end subroutine
+end
+
--
2.46.0



Re: [patch, fortran] Add random numbers and fix some bugs.

2024-09-19 Thread Thomas Koenig

Am 19.09.24 um 12:16 schrieb Andre Vehreschild:

Hi Thomas,

submitting your patch as part of the mail got it corrupted by some mailer
adding line breaks. It does not apply for me. Because I can't test it, I have
more questions, see below:


I have attached it.



On Wed, 18 Sep 2024 22:22:15 +0200
Thomas Koenig  wrote:


This patch adds random number support for UNSIGNED, plus fixes
two bugs, with array I/O where the type used to be set to BT_INTEGER,
and for division with the divisor being a constant.

Again, depends on prevous submissions.

OK for trunk?

gcc/fortran/ChangeLog:

* check.cc (gfc_check_random_number): Adjust for unsigned.
* iresolve.cc (gfc_resolve_random_number): Handle unsinged.


Hihi, I do this typo, too, over and over again: s/unsinged/unsigned/


Yep :-) It's like it is burned into my fingers or something.


* trans-expr.cc (gfc_conv_expr_op): Handle BT_UNSIGNED for divide.
* trans-types.cc (gfc_get_dtype_rank_type): Handle BT_UNSIGNED.
* gfortran.texi: Add RANDOM_NUMBER for UNSIGNED.






diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 533c9d7d343..1851cfb8d4a 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -7007,8 +7007,14 @@ gfc_check_random_init (gfc_expr *repeatable,
gfc_expr *image_distinct)
   bool
   gfc_check_random_number (gfc_expr *harvest)
   {
-  if (!type_check (harvest, 0, BT_REAL))
-return false;
+  if (flag_unsigned)
+{
+  if (!type_check2 (harvest, 0, BT_REAL, BT_UNSIGNED))
+   return false;


When the second argument is a BT_INTEGER, does this fail here?


As it should.  RANDOM_NUMBER usually is for REALs only.  I thought
it an obvious idea to extend it to unsigned integers, but only got
the idea after the document was finalized, so I'm implementing
it anyway.


+}
+  else
+if (!type_check (harvest, 0, BT_REAL))
+  return false;

 if (!variable_check (harvest, 0, false))
   return false;




Best regards

Thomas
From 898be1e536614f6a8eb2cb59c3dbcd8277922d8f Mon Sep 17 00:00:00 2001
From: Thomas Koenig 
Date: Wed, 18 Sep 2024 22:02:03 +0200
Subject: [PATCH 2/2] Add random numbers and fix some bugs.

This patch adds random number support for UNSIGNED, plus fixes
two bugs, with array I/O where the type used to be set to BT_INTEGER,
and for division with the divisor being a constant.

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_random_number): Adjust for unsigned.
	* iresolve.cc (gfc_resolve_random_number): Handle unsinged.
	* trans-expr.cc (gfc_conv_expr_op): Handle BT_UNSIGNED for divide.
	* trans-types.cc (gfc_get_dtype_rank_type): Handle BT_UNSIGNED.
	* gfortran.texi: Add RANDOM_NUMBER for UNSIGNED.

libgfortran/ChangeLog:

	* gfortran.map: Add _gfortran_random_m1, _gfortran_random_m2,
	_gfortran_random_m4, _gfortran_random_m8 and _gfortran_random_m16.
	* intrinsics/random.c (random_m1): New function.
	(random_m2): New function.
	(random_m4): New function.
	(random_m8): New function.
	(random_m16): New function.
	(arandom_m1): New function.
	(arandom_m2): New function.
	(arandom_m4): New function.
	(arandom_m8): New funciton.
	(arandom_m16): New function.

gcc/testsuite/ChangeLog:

	* gfortran.dg/unsigned_30.f90: New test.
---
 gcc/fortran/check.cc  |  10 +-
 gcc/fortran/gfortran.texi |   1 +
 gcc/fortran/iresolve.cc   |   6 +-
 gcc/fortran/trans-expr.cc |   4 +-
 gcc/fortran/trans-types.cc|   7 +-
 gcc/testsuite/gfortran.dg/unsigned_30.f90 |  63 
 libgfortran/gfortran.map  |  10 +
 libgfortran/intrinsics/random.c   | 440 ++
 8 files changed, 534 insertions(+), 7 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/unsigned_30.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 533c9d7d343..1851cfb8d4a 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -7007,8 +7007,14 @@ gfc_check_random_init (gfc_expr *repeatable, gfc_expr *image_distinct)
 bool
 gfc_check_random_number (gfc_expr *harvest)
 {
-  if (!type_check (harvest, 0, BT_REAL))
-return false;
+  if (flag_unsigned)
+{
+  if (!type_check2 (harvest, 0, BT_REAL, BT_UNSIGNED))
+	return false;
+}
+  else
+if (!type_check (harvest, 0, BT_REAL))
+  return false;
 
   if (!variable_check (harvest, 0, false))
 return false;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 3eb8039c09f..a5ebadff3bb 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -2790,6 +2790,7 @@ As of now, the following intrinsics take unsigned arguments:
 @item @code{TRANSFER}
 @item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT}
 @item @code{IANY}, @code{IALL} and @code{IPARITY}
+@item @code{RANDOM_NUMBER}.
 @end itemize
 This list will grow in the near future.
 @c -
diff --git a/gcc/fortran/iresolve.cc b