From 5dace4bf90ee311424ac625f9c1e2a9693df1ba9 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 18 Jun 2017 18:04:19 +0000 Subject: [PATCH] re PR fortran/52473 (CSHIFT slow - inline it?) 2017-06-18 Thomas Koenig PR fortran/52473 * m4/cshift0.m4: For arrays that are contiguous up to shift, implement blocked algorighm for cshift. * generated/cshift0_c10.c: Regenerated. * generated/cshift0_c16.c: Regenerated. * generated/cshift0_c4.c: Regenerated. * generated/cshift0_c8.c: Regenerated. * generated/cshift0_i1.c: Regenerated. * generated/cshift0_i16.c: Regenerated. * generated/cshift0_i2.c: Regenerated. * generated/cshift0_i4.c: Regenerated. * generated/cshift0_i8.c: Regenerated. * generated/cshift0_r10.c: Regenerated. * generated/cshift0_r16.c: Regenerated. * generated/cshift0_r4.c: Regenerated. * generated/cshift0_r8.c: Regenerated. 2017-06-18 Thomas Koenig PR fortran/52473 * gfortran.dg/cshift_1.f90: New test. From-SVN: r249350 --- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/cshift_1.f90 | 108 +++++++++++++++++++++++ libgfortran/ChangeLog | 19 ++++ libgfortran/generated/cshift0_c10.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_c16.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_c4.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_c8.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_i1.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_i16.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_i2.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_i4.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_i8.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_r10.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_r16.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_r4.c | 117 ++++++++++++++++++++----- libgfortran/generated/cshift0_r8.c | 117 ++++++++++++++++++++----- libgfortran/m4/cshift0.m4 | 117 ++++++++++++++++++++----- 17 files changed, 1434 insertions(+), 336 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/cshift_1.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ea83e353d8c..9200ee89f86 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-06-18 Thomas Koenig + + PR fortran/52473 + * gfortran.dg/cshift_1.f90: New test. + 2017-06-17 Rainer Orth Remove dg-skip-if, dg-xfail-if, dg-xfail-run-if default args. diff --git a/gcc/testsuite/gfortran.dg/cshift_1.f90 b/gcc/testsuite/gfortran.dg/cshift_1.f90 new file mode 100644 index 00000000000..e2024ea99dd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/cshift_1.f90 @@ -0,0 +1,108 @@ +! { dg-do run } +! Take cshift through its paces to make sure no boundary +! cases are wrong. + +module kinds + integer, parameter :: sp = selected_real_kind(6) ! Single precision +end module kinds + +module replacements + use kinds +contains + subroutine cshift_sp_3_v1 (array, shift, dim, res) + integer, parameter :: wp = sp + real(kind=wp), dimension(:,:,:), intent(in) :: array + integer, intent(in) :: shift, dim + real(kind=wp), dimension(:,:,:), intent(out) :: res + integer :: i,j,k + integer :: sh, rsh + integer :: n + integer :: n2, n3 + res = 0 + n3 = size(array,3) + n2 = size(array,2) + n1 = size(array,1) + if (dim == 1) then + n = n1 + sh = modulo(shift, n) + rsh = n - sh + do k=1, n3 + do j=1, n2 + do i=1, rsh + res(i,j,k) = array(i+sh,j,k) + end do + do i=rsh+1,n + res(i,j,k) = array(i-rsh,j,k) + end do + end do + end do + else if (dim == 2) then + n = n2 + sh = modulo(shift,n) + rsh = n - sh + do k=1, n3 + do j=1, rsh + do i=1, n1 + res(i,j,k) = array(i,j+sh, k) + end do + end do + do j=rsh+1, n + do i=1, n1 + res(i,j,k) = array(i,j-rsh, k) + end do + end do + end do + else if (dim == 3) then + n = n3 + sh = modulo(shift, n) + rsh = n - sh + do k=1, rsh + do j=1, n2 + do i=1, n1 + res(i,j,k) = array(i, j, k+sh) + end do + end do + end do + do k=rsh+1, n + do j=1, n2 + do i=1, n1 + res(i,j, k) = array(i, j, k-rsh) + end do + end do + end do + else + stop "Wrong argument to dim" + end if + end subroutine cshift_sp_3_v1 +end module replacements + +program testme + use kinds + use replacements + implicit none + integer, parameter :: wp = sp ! Working precision + INTEGER, PARAMETER :: n = 7 + real(kind=wp), dimension(:,:,:), allocatable :: a,b,c + integer i, j, k + real:: t1, t2 + integer, parameter :: nrep = 20 + + allocate (a(n,n,n), b(n,n,n),c(n,n,n)) + call random_number(a) + do k = 1,3 + do i=-3,3,2 + call cshift_sp_3_v1 (a, i, k, b) + c = cshift(a,i,k) + if (any (c /= b)) call abort + end do + end do + deallocate (b,c) + allocate (b(n-1,n-1,n-1),c(n-1,n-1,n-1)) + do k=1,3 + do i=-3,3,2 + call cshift_sp_3_v1 (a(1:n-1,1:n-1,1:n-1), i, k, b) + c = cshift(a(1:n-1,1:n-1,1:n-1), i, k) + if (any (c /= b)) call abort + end do + end do +end program testme diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 1f5a0264172..4f7b79dc12a 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,22 @@ +2017-06-18 Thomas Koenig + + PR fortran/52473 + * m4/cshift0.m4: For arrays that are contiguous up to + shift, implement blocked algorighm for cshift. + * generated/cshift0_c10.c: Regenerated. + * generated/cshift0_c16.c: Regenerated. + * generated/cshift0_c4.c: Regenerated. + * generated/cshift0_c8.c: Regenerated. + * generated/cshift0_i1.c: Regenerated. + * generated/cshift0_i16.c: Regenerated. + * generated/cshift0_i2.c: Regenerated. + * generated/cshift0_i4.c: Regenerated. + * generated/cshift0_i8.c: Regenerated. + * generated/cshift0_r10.c: Regenerated. + * generated/cshift0_r16.c: Regenerated. + * generated/cshift0_r4.c: Regenerated. + * generated/cshift0_r8.c: Regenerated. + 2017-06-06 Thomas Koenig PR fortran/80975 diff --git a/libgfortran/generated/cshift0_c10.c b/libgfortran/generated/cshift0_c10.c index c123d66d1aa..120ea91bea7 100644 --- a/libgfortran/generated/cshift0_c10.c +++ b/libgfortran/generated/cshift0_c10.c @@ -51,6 +51,9 @@ cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_c16.c b/libgfortran/generated/cshift0_c16.c index 7a80006b44e..821cf29c2d6 100644 --- a/libgfortran/generated/cshift0_c16.c +++ b/libgfortran/generated/cshift0_c16.c @@ -51,6 +51,9 @@ cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_c4.c b/libgfortran/generated/cshift0_c4.c index 92f7099b893..83c751e2787 100644 --- a/libgfortran/generated/cshift0_c4.c +++ b/libgfortran/generated/cshift0_c4.c @@ -51,6 +51,9 @@ cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_c8.c b/libgfortran/generated/cshift0_c8.c index 995ea90bd5c..920f05735ad 100644 --- a/libgfortran/generated/cshift0_c8.c +++ b/libgfortran/generated/cshift0_c8.c @@ -51,6 +51,9 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_i1.c b/libgfortran/generated/cshift0_i1.c index afb91136cd1..320134da221 100644 --- a/libgfortran/generated/cshift0_i1.c +++ b/libgfortran/generated/cshift0_i1.c @@ -51,6 +51,9 @@ cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_i16.c b/libgfortran/generated/cshift0_i16.c index aa0384268cf..ca1fa3b8253 100644 --- a/libgfortran/generated/cshift0_i16.c +++ b/libgfortran/generated/cshift0_i16.c @@ -51,6 +51,9 @@ cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_i2.c b/libgfortran/generated/cshift0_i2.c index c5c7d9e41d3..841ae38292b 100644 --- a/libgfortran/generated/cshift0_i2.c +++ b/libgfortran/generated/cshift0_i2.c @@ -51,6 +51,9 @@ cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_i4.c b/libgfortran/generated/cshift0_i4.c index 22bd33426f9..87713655d6a 100644 --- a/libgfortran/generated/cshift0_i4.c +++ b/libgfortran/generated/cshift0_i4.c @@ -51,6 +51,9 @@ cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_i8.c b/libgfortran/generated/cshift0_i8.c index 5d40cc708c4..7c55358fee8 100644 --- a/libgfortran/generated/cshift0_i8.c +++ b/libgfortran/generated/cshift0_i8.c @@ -51,6 +51,9 @@ cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_r10.c b/libgfortran/generated/cshift0_r10.c index 4f2feae68e2..c2f5ca687ca 100644 --- a/libgfortran/generated/cshift0_r10.c +++ b/libgfortran/generated/cshift0_r10.c @@ -51,6 +51,9 @@ cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_r16.c b/libgfortran/generated/cshift0_r16.c index d18a207e430..abbea68a4f8 100644 --- a/libgfortran/generated/cshift0_r16.c +++ b/libgfortran/generated/cshift0_r16.c @@ -51,6 +51,9 @@ cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_r4.c b/libgfortran/generated/cshift0_r4.c index 5b9e3ae7e7d..07885660964 100644 --- a/libgfortran/generated/cshift0_r4.c +++ b/libgfortran/generated/cshift0_r4.c @@ -51,6 +51,9 @@ cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/generated/cshift0_r8.c b/libgfortran/generated/cshift0_r8.c index eacc8cfc340..13e3a5c02d4 100644 --- a/libgfortran/generated/cshift0_r8.c +++ b/libgfortran/generated/cshift0_r8.c @@ -51,6 +51,9 @@ cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -63,33 +66,99 @@ cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4 index 3a824409682..04459d72195 100644 --- a/libgfortran/m4/cshift0.m4 +++ b/libgfortran/m4/cshift0.m4 @@ -52,6 +52,9 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, index_type len; index_type n; + bool do_blocked; + index_type r_ex, a_ex; + which = which - 1; sstride[0] = 0; rstride[0] = 0; @@ -64,33 +67,99 @@ cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift, soffset = 1; len = 0; - for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + r_ex = 1; + a_ex = 1; + + if (which > 0) { - if (dim == which) - { - roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); - if (roffset == 0) - roffset = 1; - soffset = GFC_DESCRIPTOR_STRIDE(array,dim); - if (soffset == 0) - soffset = 1; - len = GFC_DESCRIPTOR_EXTENT(array,dim); - } - else - { - count[n] = 0; - extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); - rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); - sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); - n++; - } + /* Test if both ret and array are contiguous. */ + 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); + } + } + else + do_blocked = false; + + n = 0; + + if (do_blocked) + { + /* For contiguous arrays, use the relationship that + + dimension(n1,n2,n3) :: a, b + b = cshift(a,sh,3) + + can be dealt with as if + + dimension(n1*n2*n3) :: an, bn + bn = cshift(a,sh*n1*n2,1) + + we can used a more blocked algorithm for dim>1. */ + sstride[0] = 1; + rstride[0] = 1; + roffset = 1; + soffset = 1; + len = GFC_DESCRIPTOR_STRIDE(array, which) + * GFC_DESCRIPTOR_EXTENT(array, which); + shift *= GFC_DESCRIPTOR_STRIDE(array, which); + 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(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + dim = GFC_DESCRIPTOR_RANK (array) - which; + } + else + { + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); } - if (sstride[0] == 0) - sstride[0] = 1; - if (rstride[0] == 0) - rstride[0] = 1; - dim = GFC_DESCRIPTOR_RANK (array); rstride0 = rstride[0]; sstride0 = sstride[0]; rptr = ret->base_addr; -- 2.30.2