OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/52473 (CSHIFT slow - inline it?) 

2017-06-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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  <tkoenig@gcc.gnu.org>

	PR fortran/52473
	* gfortran.dg/cshift_1.f90:  New test.

From-SVN: r249350
This commit is contained in:
Thomas Koenig 2017-06-18 18:04:19 +00:00
parent 82aa64e5af
commit 5dace4bf90
17 changed files with 1462 additions and 364 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2017-06-18 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/52473
* gfortran.dg/cshift_1.f90: New test.
2017-06-17 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
Remove dg-skip-if, dg-xfail-if, dg-xfail-run-if default args.

108
gcc/testsuite/gfortran.dg/cshift_1.f90 Normal file
View File

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

19
libgfortran/ChangeLog
View File

@ -1,3 +1,22 @@
2017-06-18 Thomas Koenig <tkoenig@gcc.gnu.org>
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 <tkoenig@gcc.gnu.org>
PR fortran/80975

121
libgfortran/generated/cshift0_c10.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_c16.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_c4.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_c8.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_i1.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_i16.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_i2.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_i4.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_i8.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_r10.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_r16.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_r4.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/generated/cshift0_r8.c
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;

121
libgfortran/m4/cshift0.m4
View File

@ -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++)
{
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;
r_ex = 1;
a_ex = 1;
if (which > 0)
{
/* 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);
}
dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;