From b677e2f67f72a8de2b0099f6548e42e4054c180f Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 2 Jul 2017 12:34:52 +0000 Subject: [PATCH] eoshift0.c: For contiguous arrays, use block algorithm. 2017-07-02 Thomas Koenig * intrinsics/eoshift0.c: For contiguous arrays, use block algorithm. Use memcpy where possible. 2017-07-02 Thomas Koenig * gfortran/eoshift_3.f90: New test. From-SVN: r249882 --- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/eoshift_3.f90 | 178 ++++++++++++++++++++++++ libgfortran/ChangeLog | 5 + libgfortran/intrinsics/eoshift0.c | 144 ++++++++++++++----- 4 files changed, 295 insertions(+), 36 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/eoshift_3.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 07b2c9dd42f..ac9c6a63d61 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2017-07-02 Thomas Koenig + + * gfortran/eoshift_3.f90: New test. + 2017-07-02 Richard Sandiford * gcc.dg/strlenopt-32.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/eoshift_3.f90 b/gcc/testsuite/gfortran.dg/eoshift_3.f90 new file mode 100644 index 00000000000..d1087aa8654 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/eoshift_3.f90 @@ -0,0 +1,178 @@ +! { dg-do run } +! Check that eoshift works for three-dimensional arrays. +module x + implicit none +contains + subroutine eoshift_0 (array, shift, boundary, dim, res) + real, dimension(:,:,:), intent(in) :: array + real, dimension(:,:,:), intent(out) :: res + integer, value :: shift + real, optional, intent(in) :: boundary + integer, optional, intent(in) :: dim + integer :: s1, s2, s3 + integer :: n1, n2, n3 + + real :: b + integer :: d + if (present(boundary)) then + b = boundary + else + b = 0.0 + end if + + if (present(dim)) then + d = dim + else + d = 1 + end if + + n1 = size(array,1) + n2 = size(array,2) + n3 = size(array,3) + + select case(dim) + case(1) + if (shift > 0) then + shift = min(shift, n1) + do s3=1,n3 + do s2=1,n2 + do s1= 1, n1 - shift + res(s1,s2,s3) = array(s1+shift,s2,s3) + end do + do s1 = n1 - shift + 1,n1 + res(s1,s2,s3) = b + end do + end do + end do + + else + shift = max(shift, -n1) + do s3=1,n3 + do s2=1,n2 + do s1=1,-shift + res(s1,s2,s3) = b + end do + do s1= 1-shift,n1 + res(s1,s2,s3) = array(s1+shift,s2,s3) + end do + end do + end do + end if + + case(2) + if (shift > 0) then + shift = min(shift, n2) + do s3=1,n3 + do s2=1, n2 - shift + do s1=1,n1 + res(s1,s2,s3) = array(s1,s2+shift,s3) + end do + end do + do s2=n2 - shift + 1, n2 + do s1=1,n1 + res(s1,s2,s3) = b + end do + end do + end do + else + shift = max(shift, -n2) + do s3=1,n3 + do s2=1,-shift + do s1=1,n1 + res(s1,s2,s3) = b + end do + end do + do s2=1-shift,n2 + do s1=1,n1 + res(s1,s2,s3) = array(s1,s2+shift,s3) + end do + end do + end do + end if + + case(3) + if (shift > 0) then + shift = min(shift, n3) + do s3=1,n3 - shift + do s2=1, n2 + do s1=1,n1 + res(s1,s2,s3) = array(s1,s2,s3+shift) + end do + end do + end do + do s3=n3 - shift + 1, n3 + do s2=1, n2 + do s1=1,n1 + res(s1,s2,s3) = b + end do + end do + end do + else + shift = max(shift, -n3) + do s3=1,-shift + do s2=1,n2 + do s1=1,n1 + res(s1,s2,s3) = b + end do + end do + end do + do s3=1-shift,n3 + do s2=1,n2 + do s1=1,n1 + res(s1,s2,s3) = array(s1,s2,s3+shift) + end do + end do + end do + end if + + case default + stop "Illegal dim" + end select + end subroutine eoshift_0 +end module x + +program main + use x + implicit none + integer, parameter :: n1=2,n2=4,n3=2 + real, dimension(n1,n2,n3) :: a,b,c + integer :: dim, shift, shift_lim + call random_number(a) + + do dim=1,3 + if (dim == 1) then + shift_lim = n1 + 1 + else if (dim == 2) then + shift_lim = n2 + 1 + else + shift_lim = n3 + 1 + end if + do shift=-shift_lim, shift_lim + b = eoshift(a,shift,dim=dim) + call eoshift_0 (a, shift=shift, dim=dim, res=c) + if (any (b /= c)) then + print *,"dim = ", dim, "shift = ", shift + call abort + end if + end do + end do + call random_number(b) + c = b + + do dim=1,3 + if (dim == 1) then + shift_lim = n1/2 + 1 + else if (dim == 2) then + shift_lim = n2/2 + 1 + else + shift_lim = n3/2 + 1 + end if + + do shift=-shift_lim, shift_lim + b(1:n1:2,:,:) = eoshift(a(1:n1/2,:,:),shift,dim=dim) + call eoshift_0 (a(1:n1/2,:,:), shift=shift, dim=dim, res=c(1:n1:2,:,:)) + if (any (b /= c)) call abort + end do + end do + +end program main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 778056ba29e..fb69c81b04b 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2017-07-02 Thomas Koenig + + * intrinsics/eoshift0.c: For contiguous arrays, use + block algorithm. Use memcpy where possible. + 2017-06-26 Jim Wilson PR libfortran/81195 diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 53a9a89f5f9..24a23c30fda 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -53,7 +53,8 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, index_type len; index_type n; index_type arraysize; - + bool do_blocked; + /* The compiler cannot figure out that these are set, initialize them to avoid warnings. */ len = 0; @@ -102,38 +103,93 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, count[0] = 0; sstride[0] = -1; rstride[0] = -1; - n = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - if (roffset == 0) - roffset = size; - soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - if (soffset == 0) - soffset = size; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + size_t r_ex, a_ex; + r_ex = 1; + a_ex = 1; + do_blocked = true; + dim = GFC_DESCRIPTOR_RANK (array); + for (n = 0; n < dim; n ++) + { + index_type rs, as; + rs = GFC_DESCRIPTOR_STRIDE (ret, n); + if (rs != r_ex) + { + do_blocked = false; + break; + } + as = GFC_DESCRIPTOR_STRIDE (array, n); + if (as != a_ex) + { + do_blocked = false; + break; + } + r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n); + a_ex *= GFC_DESCRIPTOR_EXTENT (array, n); + } } - if (sstride[0] == 0) - sstride[0] = size; - if (rstride[0] == 0) - rstride[0] = size; + else + do_blocked = false; - dim = GFC_DESCRIPTOR_RANK (array); - rstride0 = rstride[0]; - sstride0 = sstride[0]; - rptr = ret->base_addr; - sptr = array->base_addr; + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = eoshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = eoshift(a,sh*n1*n2,1) + + so a block move can be used for dim>1. */ + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + roffset = size; + soffset = size; + for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + n++; + } + count[n] = 0; + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + n++; + } + } + dim = GFC_DESCRIPTOR_RANK (array); + } if ((shift >= 0 ? shift : -shift) > len) { @@ -148,6 +204,11 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, len = len + shift; } + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->base_addr; + sptr = array->base_addr; + while (rptr) { /* Do the shift for this dimension. */ @@ -161,12 +222,23 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, src = sptr; dest = &rptr[-shift * roffset]; } - for (n = 0; n < len; n++) - { - memcpy (dest, src, size); - dest += roffset; - src += soffset; - } + /* If the elements are contiguous, perform a single block move. */ + + if (soffset == size && roffset == size) + { + size_t chunk = size * len; + memcpy (dest, src, chunk); + dest += chunk; + } + else + { + for (n = 0; n < len; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + } if (shift >= 0) { n = shift; -- 2.30.2