2018-07-12 Richard Biener <rguenther@suse.de>
[official-gcc.git] / libgfortran / generated / eoshift1_4.c
blob6848c50d88cda4df6602e3e6df03bb876d27f862
1 /* Implementation of the EOSHIFT intrinsic
2 Copyright (C) 2002-2018 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.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"
27 #include <string.h>
30 #if defined (HAVE_GFC_INTEGER_4)
32 static void
33 eoshift1 (gfc_array_char * const restrict ret,
34 const gfc_array_char * const restrict array,
35 const gfc_array_i4 * const restrict h,
36 const char * const restrict pbound,
37 const GFC_INTEGER_4 * const restrict pwhich,
38 const char * filler, index_type filler_len)
40 /* r.* indicates the return array. */
41 index_type rstride[GFC_MAX_DIMENSIONS];
42 index_type rstride0;
43 index_type roffset;
44 char *rptr;
45 char * restrict dest;
46 /* s.* indicates the source array. */
47 index_type sstride[GFC_MAX_DIMENSIONS];
48 index_type sstride0;
49 index_type soffset;
50 const char *sptr;
51 const char *src;
52 /* h.* indicates the shift array. */
53 index_type hstride[GFC_MAX_DIMENSIONS];
54 index_type hstride0;
55 const GFC_INTEGER_4 *hptr;
57 index_type count[GFC_MAX_DIMENSIONS];
58 index_type extent[GFC_MAX_DIMENSIONS];
59 index_type dim;
60 index_type len;
61 index_type n;
62 index_type size;
63 index_type arraysize;
64 int which;
65 GFC_INTEGER_4 sh;
66 GFC_INTEGER_4 delta;
68 /* The compiler cannot figure out that these are set, initialize
69 them to avoid warnings. */
70 len = 0;
71 soffset = 0;
72 roffset = 0;
74 size = GFC_DESCRIPTOR_SIZE(array);
76 if (pwhich)
77 which = *pwhich - 1;
78 else
79 which = 0;
81 extent[0] = 1;
82 count[0] = 0;
84 arraysize = size0 ((array_t *) array);
85 if (ret->base_addr == NULL)
87 ret->offset = 0;
88 GFC_DTYPE_COPY(ret,array);
89 for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
91 index_type ub, str;
93 ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
95 if (i == 0)
96 str = 1;
97 else
98 str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
99 * GFC_DESCRIPTOR_STRIDE(ret,i-1);
101 GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
104 /* xmallocarray allocates a single byte for zero size. */
105 ret->base_addr = xmallocarray (arraysize, size);
108 else if (unlikely (compile_options.bounds_check))
110 bounds_equal_extents ((array_t *) ret, (array_t *) array,
111 "return value", "EOSHIFT");
114 if (unlikely (compile_options.bounds_check))
116 bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
117 "SHIFT argument", "EOSHIFT");
120 if (arraysize == 0)
121 return;
123 n = 0;
124 for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
126 if (dim == which)
128 roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
129 if (roffset == 0)
130 roffset = size;
131 soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
132 if (soffset == 0)
133 soffset = size;
134 len = GFC_DESCRIPTOR_EXTENT(array,dim);
136 else
138 count[n] = 0;
139 extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
140 rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
141 sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
143 hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
144 n++;
147 if (sstride[0] == 0)
148 sstride[0] = size;
149 if (rstride[0] == 0)
150 rstride[0] = size;
151 if (hstride[0] == 0)
152 hstride[0] = 1;
154 dim = GFC_DESCRIPTOR_RANK (array);
155 rstride0 = rstride[0];
156 sstride0 = sstride[0];
157 hstride0 = hstride[0];
158 rptr = ret->base_addr;
159 sptr = array->base_addr;
160 hptr = h->base_addr;
162 while (rptr)
164 /* Do the shift for this dimension. */
165 sh = *hptr;
166 if (( sh >= 0 ? sh : -sh ) > len)
168 delta = len;
169 sh = len;
171 else
172 delta = (sh >= 0) ? sh: -sh;
174 if (sh > 0)
176 src = &sptr[delta * soffset];
177 dest = rptr;
179 else
181 src = sptr;
182 dest = &rptr[delta * roffset];
185 /* If the elements are contiguous, perform a single block move. */
186 if (soffset == size && roffset == size)
188 size_t chunk = size * (len - delta);
189 memcpy (dest, src, chunk);
190 dest += chunk;
192 else
194 for (n = 0; n < len - delta; n++)
196 memcpy (dest, src, size);
197 dest += roffset;
198 src += soffset;
201 if (sh < 0)
202 dest = rptr;
203 n = delta;
205 if (pbound)
206 while (n--)
208 memcpy (dest, pbound, size);
209 dest += roffset;
211 else
212 while (n--)
214 index_type i;
216 if (filler_len == 1)
217 memset (dest, filler[0], size);
218 else
219 for (i = 0; i < size; i += filler_len)
220 memcpy (&dest[i], filler, filler_len);
222 dest += roffset;
225 /* Advance to the next section. */
226 rptr += rstride0;
227 sptr += sstride0;
228 hptr += hstride0;
229 count[0]++;
230 n = 0;
231 while (count[n] == extent[n])
233 /* When we get to the end of a dimension, reset it and increment
234 the next dimension. */
235 count[n] = 0;
236 /* We could precalculate these products, but this is a less
237 frequently used path so probably not worth it. */
238 rptr -= rstride[n] * extent[n];
239 sptr -= sstride[n] * extent[n];
240 hptr -= hstride[n] * extent[n];
241 n++;
242 if (n >= dim - 1)
244 /* Break out of the loop. */
245 rptr = NULL;
246 break;
248 else
250 count[n]++;
251 rptr += rstride[n];
252 sptr += sstride[n];
253 hptr += hstride[n];
259 void eoshift1_4 (gfc_array_char * const restrict,
260 const gfc_array_char * const restrict,
261 const gfc_array_i4 * const restrict, const char * const restrict,
262 const GFC_INTEGER_4 * const restrict);
263 export_proto(eoshift1_4);
265 void
266 eoshift1_4 (gfc_array_char * const restrict ret,
267 const gfc_array_char * const restrict array,
268 const gfc_array_i4 * const restrict h,
269 const char * const restrict pbound,
270 const GFC_INTEGER_4 * const restrict pwhich)
272 eoshift1 (ret, array, h, pbound, pwhich, "\0", 1);
276 void eoshift1_4_char (gfc_array_char * const restrict,
277 GFC_INTEGER_4,
278 const gfc_array_char * const restrict,
279 const gfc_array_i4 * const restrict,
280 const char * const restrict,
281 const GFC_INTEGER_4 * const restrict,
282 GFC_INTEGER_4, GFC_INTEGER_4);
283 export_proto(eoshift1_4_char);
285 void
286 eoshift1_4_char (gfc_array_char * const restrict ret,
287 GFC_INTEGER_4 ret_length __attribute__((unused)),
288 const gfc_array_char * const restrict array,
289 const gfc_array_i4 * const restrict h,
290 const char * const restrict pbound,
291 const GFC_INTEGER_4 * const restrict pwhich,
292 GFC_INTEGER_4 array_length __attribute__((unused)),
293 GFC_INTEGER_4 bound_length __attribute__((unused)))
295 eoshift1 (ret, array, h, pbound, pwhich, " ", 1);
299 void eoshift1_4_char4 (gfc_array_char * const restrict,
300 GFC_INTEGER_4,
301 const gfc_array_char * const restrict,
302 const gfc_array_i4 * const restrict,
303 const char * const restrict,
304 const GFC_INTEGER_4 * const restrict,
305 GFC_INTEGER_4, GFC_INTEGER_4);
306 export_proto(eoshift1_4_char4);
308 void
309 eoshift1_4_char4 (gfc_array_char * const restrict ret,
310 GFC_INTEGER_4 ret_length __attribute__((unused)),
311 const gfc_array_char * const restrict array,
312 const gfc_array_i4 * const restrict h,
313 const char * const restrict pbound,
314 const GFC_INTEGER_4 * const restrict pwhich,
315 GFC_INTEGER_4 array_length __attribute__((unused)),
316 GFC_INTEGER_4 bound_length __attribute__((unused)))
318 static const gfc_char4_t space = (unsigned char) ' ';
319 eoshift1 (ret, array, h, pbound, pwhich,
320 (const char *) &space, sizeof (gfc_char4_t));
323 #endif