1760c2415Smrg /* Helper function for cshift functions.
2*0bfacb9bSmrg Copyright (C) 2008-2020 Free Software Foundation, Inc.
3760c2415Smrg Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
4760c2415Smrg
5760c2415Smrg This file is part of the GNU Fortran runtime library (libgfortran).
6760c2415Smrg
7760c2415Smrg Libgfortran is free software; you can redistribute it and/or
8760c2415Smrg modify it under the terms of the GNU General Public
9760c2415Smrg License as published by the Free Software Foundation; either
10760c2415Smrg version 3 of the License, or (at your option) any later version.
11760c2415Smrg
12760c2415Smrg Libgfortran is distributed in the hope that it will be useful,
13760c2415Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
14760c2415Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15760c2415Smrg GNU General Public License for more details.
16760c2415Smrg
17760c2415Smrg Under Section 7 of GPL version 3, you are granted additional
18760c2415Smrg permissions described in the GCC Runtime Library Exception, version
19760c2415Smrg 3.1, as published by the Free Software Foundation.
20760c2415Smrg
21760c2415Smrg You should have received a copy of the GNU General Public License and
22760c2415Smrg a copy of the GCC Runtime Library Exception along with this program;
23760c2415Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24760c2415Smrg <http://www.gnu.org/licenses/>. */
25760c2415Smrg
26760c2415Smrg #include "libgfortran.h"
27760c2415Smrg #include <string.h>
28760c2415Smrg
29760c2415Smrg
30760c2415Smrg #if defined (HAVE_GFC_COMPLEX_16)
31760c2415Smrg
32760c2415Smrg void
cshift0_c16(gfc_array_c16 * ret,const gfc_array_c16 * array,ptrdiff_t shift,int which)33760c2415Smrg cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ptrdiff_t shift,
34760c2415Smrg int which)
35760c2415Smrg {
36760c2415Smrg /* r.* indicates the return array. */
37760c2415Smrg index_type rstride[GFC_MAX_DIMENSIONS];
38760c2415Smrg index_type rstride0;
39760c2415Smrg index_type roffset;
40760c2415Smrg GFC_COMPLEX_16 *rptr;
41760c2415Smrg
42760c2415Smrg /* s.* indicates the source array. */
43760c2415Smrg index_type sstride[GFC_MAX_DIMENSIONS];
44760c2415Smrg index_type sstride0;
45760c2415Smrg index_type soffset;
46760c2415Smrg const GFC_COMPLEX_16 *sptr;
47760c2415Smrg
48760c2415Smrg index_type count[GFC_MAX_DIMENSIONS];
49760c2415Smrg index_type extent[GFC_MAX_DIMENSIONS];
50760c2415Smrg index_type dim;
51760c2415Smrg index_type len;
52760c2415Smrg index_type n;
53760c2415Smrg
54760c2415Smrg bool do_blocked;
55760c2415Smrg index_type r_ex, a_ex;
56760c2415Smrg
57760c2415Smrg which = which - 1;
58760c2415Smrg sstride[0] = 0;
59760c2415Smrg rstride[0] = 0;
60760c2415Smrg
61760c2415Smrg extent[0] = 1;
62760c2415Smrg count[0] = 0;
63760c2415Smrg n = 0;
64760c2415Smrg /* Initialized for avoiding compiler warnings. */
65760c2415Smrg roffset = 1;
66760c2415Smrg soffset = 1;
67760c2415Smrg len = 0;
68760c2415Smrg
69760c2415Smrg r_ex = 1;
70760c2415Smrg a_ex = 1;
71760c2415Smrg
72760c2415Smrg if (which > 0)
73760c2415Smrg {
74760c2415Smrg /* Test if both ret and array are contiguous. */
75760c2415Smrg do_blocked = true;
76760c2415Smrg dim = GFC_DESCRIPTOR_RANK (array);
77760c2415Smrg for (n = 0; n < dim; n ++)
78760c2415Smrg {
79760c2415Smrg index_type rs, as;
80760c2415Smrg rs = GFC_DESCRIPTOR_STRIDE (ret, n);
81760c2415Smrg if (rs != r_ex)
82760c2415Smrg {
83760c2415Smrg do_blocked = false;
84760c2415Smrg break;
85760c2415Smrg }
86760c2415Smrg as = GFC_DESCRIPTOR_STRIDE (array, n);
87760c2415Smrg if (as != a_ex)
88760c2415Smrg {
89760c2415Smrg do_blocked = false;
90760c2415Smrg break;
91760c2415Smrg }
92760c2415Smrg r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
93760c2415Smrg a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
94760c2415Smrg }
95760c2415Smrg }
96760c2415Smrg else
97760c2415Smrg do_blocked = false;
98760c2415Smrg
99760c2415Smrg n = 0;
100760c2415Smrg
101760c2415Smrg if (do_blocked)
102760c2415Smrg {
103760c2415Smrg /* For contiguous arrays, use the relationship that
104760c2415Smrg
105760c2415Smrg dimension(n1,n2,n3) :: a, b
106760c2415Smrg b = cshift(a,sh,3)
107760c2415Smrg
108760c2415Smrg can be dealt with as if
109760c2415Smrg
110760c2415Smrg dimension(n1*n2*n3) :: an, bn
111760c2415Smrg bn = cshift(a,sh*n1*n2,1)
112760c2415Smrg
113760c2415Smrg we can used a more blocked algorithm for dim>1. */
114760c2415Smrg sstride[0] = 1;
115760c2415Smrg rstride[0] = 1;
116760c2415Smrg roffset = 1;
117760c2415Smrg soffset = 1;
118760c2415Smrg len = GFC_DESCRIPTOR_STRIDE(array, which)
119760c2415Smrg * GFC_DESCRIPTOR_EXTENT(array, which);
120760c2415Smrg shift *= GFC_DESCRIPTOR_STRIDE(array, which);
121760c2415Smrg for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
122760c2415Smrg {
123760c2415Smrg count[n] = 0;
124760c2415Smrg extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
125760c2415Smrg rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
126760c2415Smrg sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
127760c2415Smrg n++;
128760c2415Smrg }
129760c2415Smrg dim = GFC_DESCRIPTOR_RANK (array) - which;
130760c2415Smrg }
131760c2415Smrg else
132760c2415Smrg {
133760c2415Smrg for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
134760c2415Smrg {
135760c2415Smrg if (dim == which)
136760c2415Smrg {
137760c2415Smrg roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
138760c2415Smrg if (roffset == 0)
139760c2415Smrg roffset = 1;
140760c2415Smrg soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
141760c2415Smrg if (soffset == 0)
142760c2415Smrg soffset = 1;
143760c2415Smrg len = GFC_DESCRIPTOR_EXTENT(array,dim);
144760c2415Smrg }
145760c2415Smrg else
146760c2415Smrg {
147760c2415Smrg count[n] = 0;
148760c2415Smrg extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
149760c2415Smrg rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
150760c2415Smrg sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
151760c2415Smrg n++;
152760c2415Smrg }
153760c2415Smrg }
154760c2415Smrg if (sstride[0] == 0)
155760c2415Smrg sstride[0] = 1;
156760c2415Smrg if (rstride[0] == 0)
157760c2415Smrg rstride[0] = 1;
158760c2415Smrg
159760c2415Smrg dim = GFC_DESCRIPTOR_RANK (array);
160760c2415Smrg }
161760c2415Smrg
162760c2415Smrg rstride0 = rstride[0];
163760c2415Smrg sstride0 = sstride[0];
164760c2415Smrg rptr = ret->base_addr;
165760c2415Smrg sptr = array->base_addr;
166760c2415Smrg
167760c2415Smrg /* Avoid the costly modulo for trivially in-bound shifts. */
168760c2415Smrg if (shift < 0 || shift >= len)
169760c2415Smrg {
170760c2415Smrg shift = len == 0 ? 0 : shift % (ptrdiff_t)len;
171760c2415Smrg if (shift < 0)
172760c2415Smrg shift += len;
173760c2415Smrg }
174760c2415Smrg
175760c2415Smrg while (rptr)
176760c2415Smrg {
177760c2415Smrg /* Do the shift for this dimension. */
178760c2415Smrg
179760c2415Smrg /* If elements are contiguous, perform the operation
180760c2415Smrg in two block moves. */
181760c2415Smrg if (soffset == 1 && roffset == 1)
182760c2415Smrg {
183760c2415Smrg size_t len1 = shift * sizeof (GFC_COMPLEX_16);
184760c2415Smrg size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_16);
185760c2415Smrg memcpy (rptr, sptr + shift, len2);
186760c2415Smrg memcpy (rptr + (len - shift), sptr, len1);
187760c2415Smrg }
188760c2415Smrg else
189760c2415Smrg {
190760c2415Smrg /* Otherwise, we will have to perform the copy one element at
191760c2415Smrg a time. */
192760c2415Smrg GFC_COMPLEX_16 *dest = rptr;
193760c2415Smrg const GFC_COMPLEX_16 *src = &sptr[shift * soffset];
194760c2415Smrg
195760c2415Smrg for (n = 0; n < len - shift; n++)
196760c2415Smrg {
197760c2415Smrg *dest = *src;
198760c2415Smrg dest += roffset;
199760c2415Smrg src += soffset;
200760c2415Smrg }
201760c2415Smrg for (src = sptr, n = 0; n < shift; n++)
202760c2415Smrg {
203760c2415Smrg *dest = *src;
204760c2415Smrg dest += roffset;
205760c2415Smrg src += soffset;
206760c2415Smrg }
207760c2415Smrg }
208760c2415Smrg
209760c2415Smrg /* Advance to the next section. */
210760c2415Smrg rptr += rstride0;
211760c2415Smrg sptr += sstride0;
212760c2415Smrg count[0]++;
213760c2415Smrg n = 0;
214760c2415Smrg while (count[n] == extent[n])
215760c2415Smrg {
216760c2415Smrg /* When we get to the end of a dimension, reset it and increment
217760c2415Smrg the next dimension. */
218760c2415Smrg count[n] = 0;
219760c2415Smrg /* We could precalculate these products, but this is a less
220760c2415Smrg frequently used path so probably not worth it. */
221760c2415Smrg rptr -= rstride[n] * extent[n];
222760c2415Smrg sptr -= sstride[n] * extent[n];
223760c2415Smrg n++;
224760c2415Smrg if (n >= dim - 1)
225760c2415Smrg {
226760c2415Smrg /* Break out of the loop. */
227760c2415Smrg rptr = NULL;
228760c2415Smrg break;
229760c2415Smrg }
230760c2415Smrg else
231760c2415Smrg {
232760c2415Smrg count[n]++;
233760c2415Smrg rptr += rstride[n];
234760c2415Smrg sptr += sstride[n];
235760c2415Smrg }
236760c2415Smrg }
237760c2415Smrg }
238760c2415Smrg
239760c2415Smrg return;
240760c2415Smrg }
241760c2415Smrg
242760c2415Smrg #endif
243