1 /* Helper function for cshift functions.
2 Copyright (C) 2008-2021 Free Software Foundation, Inc.
3 Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
5 This file is part of the GNU Fortran runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public
9 License as published by the Free Software Foundation; either
10 version 3 of the License, or (at your option) any later version.
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
26 #include "libgfortran.h"
30 #if defined (HAVE_GFC_COMPLEX_10)
33 cshift0_c10 (gfc_array_c10
*ret
, const gfc_array_c10
*array
, ptrdiff_t shift
,
36 /* r.* indicates the return array. */
37 index_type rstride
[GFC_MAX_DIMENSIONS
];
42 /* s.* indicates the source array. */
43 index_type sstride
[GFC_MAX_DIMENSIONS
];
46 const GFC_COMPLEX_10
*sptr
;
48 index_type count
[GFC_MAX_DIMENSIONS
];
49 index_type extent
[GFC_MAX_DIMENSIONS
];
55 index_type r_ex
, a_ex
;
64 /* Initialized for avoiding compiler warnings. */
74 /* Test if both ret and array are contiguous. */
76 dim
= GFC_DESCRIPTOR_RANK (array
);
77 for (n
= 0; n
< dim
; n
++)
80 rs
= GFC_DESCRIPTOR_STRIDE (ret
, n
);
86 as
= GFC_DESCRIPTOR_STRIDE (array
, n
);
92 r_ex
*= GFC_DESCRIPTOR_EXTENT (ret
, n
);
93 a_ex
*= GFC_DESCRIPTOR_EXTENT (array
, n
);
103 /* For contiguous arrays, use the relationship that
105 dimension(n1,n2,n3) :: a, b
108 can be dealt with as if
110 dimension(n1*n2*n3) :: an, bn
111 bn = cshift(a,sh*n1*n2,1)
113 we can used a more blocked algorithm for dim>1. */
118 len
= GFC_DESCRIPTOR_STRIDE(array
, which
)
119 * GFC_DESCRIPTOR_EXTENT(array
, which
);
120 shift
*= GFC_DESCRIPTOR_STRIDE(array
, which
);
121 for (dim
= which
+ 1; dim
< GFC_DESCRIPTOR_RANK (array
); dim
++)
124 extent
[n
] = GFC_DESCRIPTOR_EXTENT(array
,dim
);
125 rstride
[n
] = GFC_DESCRIPTOR_STRIDE(ret
,dim
);
126 sstride
[n
] = GFC_DESCRIPTOR_STRIDE(array
,dim
);
129 dim
= GFC_DESCRIPTOR_RANK (array
) - which
;
133 for (dim
= 0; dim
< GFC_DESCRIPTOR_RANK (array
); dim
++)
137 roffset
= GFC_DESCRIPTOR_STRIDE(ret
,dim
);
140 soffset
= GFC_DESCRIPTOR_STRIDE(array
,dim
);
143 len
= GFC_DESCRIPTOR_EXTENT(array
,dim
);
148 extent
[n
] = GFC_DESCRIPTOR_EXTENT(array
,dim
);
149 rstride
[n
] = GFC_DESCRIPTOR_STRIDE(ret
,dim
);
150 sstride
[n
] = GFC_DESCRIPTOR_STRIDE(array
,dim
);
159 dim
= GFC_DESCRIPTOR_RANK (array
);
162 rstride0
= rstride
[0];
163 sstride0
= sstride
[0];
164 rptr
= ret
->base_addr
;
165 sptr
= array
->base_addr
;
167 /* Avoid the costly modulo for trivially in-bound shifts. */
168 if (shift
< 0 || shift
>= len
)
170 shift
= len
== 0 ? 0 : shift
% (ptrdiff_t)len
;
177 /* Do the shift for this dimension. */
179 /* If elements are contiguous, perform the operation
180 in two block moves. */
181 if (soffset
== 1 && roffset
== 1)
183 size_t len1
= shift
* sizeof (GFC_COMPLEX_10
);
184 size_t len2
= (len
- shift
) * sizeof (GFC_COMPLEX_10
);
185 memcpy (rptr
, sptr
+ shift
, len2
);
186 memcpy (rptr
+ (len
- shift
), sptr
, len1
);
190 /* Otherwise, we will have to perform the copy one element at
192 GFC_COMPLEX_10
*dest
= rptr
;
193 const GFC_COMPLEX_10
*src
= &sptr
[shift
* soffset
];
195 for (n
= 0; n
< len
- shift
; n
++)
201 for (src
= sptr
, n
= 0; n
< shift
; n
++)
209 /* Advance to the next section. */
214 while (count
[n
] == extent
[n
])
216 /* When we get to the end of a dimension, reset it and increment
217 the next dimension. */
219 /* We could precalculate these products, but this is a less
220 frequently used path so probably not worth it. */
221 rptr
-= rstride
[n
] * extent
[n
];
222 sptr
-= sstride
[n
] * extent
[n
];
226 /* Break out of the loop. */