RFC: Fix PR 94578, ignoring span in return values for intrinsics

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

RFC: Fix PR 94578, ignoring span in return values for intrinsics

gcc - fortran mailing list
Hello world,

I'm currently looking at PR 94578, which is a wrong-code bug.

A short test case is

program main
   implicit none
   type foo
      integer :: x, y,z
   end type foo
   integer :: i
   integer, dimension(:), pointer :: array1d
   type(foo), dimension(2), target :: solution
   integer, dimension(2,2) :: a
   solution%x = -10
   solution%y = -20
   data a /1,2,3,4/
   array1d => solution%x
   array1d = maxval(a,dim=1)
   print *,array1d
end program main

where array1d points to a component of a derived type, so
span is set on the return array descriptor, and the code in
the library ignores the span, storing the result in the
wrong place.

For function arguments, this is currently no issue because
we convert the array - expensive, but it gets things correct.

For results, like in this test case, we could try to make
the library span-aware, like in this patch.  I have not
been able to find a test case where this fails, but maybe
this is due to lack of imagination :-)

If this is the way to go, I will then wade through the m4
and other files to convert all affected intrinsics in this
way, which is a bit of work, so I wanted to run the
concept by you first.

So, is this how we should proceed?

Regards

        Thomas

p0a.diff.txt (2K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: RFC: Fix PR 94578, ignoring span in return values for intrinsics

gcc - fortran mailing list
Hm,

what I put into my patch doesn't really work, because of
COMPLEX:  For example, COMPLEX(4) has size 8, but alignment 4,
so that a type like

type foo
   real :: x
   complex :: c
end type foo

would not work.

However, there is a more elegant version: Use the span to
calculate strides, and to the addition in pointers to
characters.

For sum_c4.c, this would look something like the one
at the bottom of this post.

What do people think, would this be the right approach?
We can also use this for the front end, to have byte addressing
even without an API change.  But this would be something
for another release :-)

What do you think?

Regards

        Thomas

diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c
index 229bc91d784..0e2fbf27f59 100644
--- a/libgfortran/generated/sum_c4.c
+++ b/libgfortran/generated/sum_c4.c
@@ -126,12 +126,25 @@ sum_c4 (gfc_array_c4 * const restrict retarray,
  "return value", "SUM");
      }

-  for (n = 0; n < rank; n++)
+  if (unlikely (retarray->span != 0 && retarray->span != sizeof
(GFC_COMPLEX_4)))
      {
-      count[n] = 0;
-      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
-      if (extent[n] <= 0)
- return;
+      for (n = 0; n < rank; n++)
+ {
+  count[n] = 0;
+  dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n) * retarray->span;
+  if (extent[n] <= 0)
+    return;
+ }
+    }
+  else
+    {
+      for (n = 0; n < rank; n++)
+ {
+  count[n] = 0;
+  dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n) * sizeof (GFC_COMPLEX_4);
+  if (extent[n] <= 0)
+    return;
+ }
      }

    base = array->base_addr;
@@ -164,7 +177,8 @@ sum_c4 (gfc_array_c4 * const restrict retarray,
        /* Advance to the next element.  */
        count[0]++;
        base += sstride[0];
-      dest += dstride[0];
+      /* Add dstride[0] to dest, in bytes.  */
+      dest = (GFC_COMPLEX_4 *) ((char *) dest + dstride[0]);
        n = 0;
        while (count[n] == extent[n])
  {
@@ -174,7 +188,7 @@ sum_c4 (gfc_array_c4 * const restrict retarray,
   /* We could precalculate these products, but this is a less
      frequently used path so probably not worth it.  */
   base -= sstride[n] * extent[n];
-  dest -= dstride[n] * extent[n];
+  dest = (GFC_COMPLEX_4 *) ((char *) dest - dstride[n] * extent[n]);
   n++;
   if (n >= rank)
     {
@@ -186,7 +200,7 @@ sum_c4 (gfc_array_c4 * const restrict retarray,
     {
       count[n]++;
       base += sstride[n];
-      dest += dstride[n];
+      dest = (GFC_COMPLEX_4 *) ((char *) dest + dstride[n]);
     }
  }
      }