PR target/66870
[official-gcc.git] / libgfortran / generated / maxval_i4.c
blob3631699f4dde60d43b2d2485df029e42ca7e720d
1 /* Implementation of the MAXVAL intrinsic
2 Copyright (C) 2002-2015 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 <stdlib.h>
28 #include <assert.h>
31 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
34 extern void maxval_i4 (gfc_array_i4 * const restrict,
35 gfc_array_i4 * const restrict, const index_type * const restrict);
36 export_proto(maxval_i4);
38 void
39 maxval_i4 (gfc_array_i4 * const restrict retarray,
40 gfc_array_i4 * const restrict array,
41 const index_type * const restrict pdim)
43 index_type count[GFC_MAX_DIMENSIONS];
44 index_type extent[GFC_MAX_DIMENSIONS];
45 index_type sstride[GFC_MAX_DIMENSIONS];
46 index_type dstride[GFC_MAX_DIMENSIONS];
47 const GFC_INTEGER_4 * restrict base;
48 GFC_INTEGER_4 * restrict dest;
49 index_type rank;
50 index_type n;
51 index_type len;
52 index_type delta;
53 index_type dim;
54 int continue_loop;
56 /* Make dim zero based to avoid confusion. */
57 dim = (*pdim) - 1;
58 rank = GFC_DESCRIPTOR_RANK (array) - 1;
60 len = GFC_DESCRIPTOR_EXTENT(array,dim);
61 if (len < 0)
62 len = 0;
63 delta = GFC_DESCRIPTOR_STRIDE(array,dim);
65 for (n = 0; n < dim; n++)
67 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
68 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
70 if (extent[n] < 0)
71 extent[n] = 0;
73 for (n = dim; n < rank; n++)
75 sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
76 extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
78 if (extent[n] < 0)
79 extent[n] = 0;
82 if (retarray->base_addr == NULL)
84 size_t alloc_size, str;
86 for (n = 0; n < rank; n++)
88 if (n == 0)
89 str = 1;
90 else
91 str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
93 GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
97 retarray->offset = 0;
98 retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
100 alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
102 retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
103 if (alloc_size == 0)
105 /* Make sure we have a zero-sized array. */
106 GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
107 return;
111 else
113 if (rank != GFC_DESCRIPTOR_RANK (retarray))
114 runtime_error ("rank of return array incorrect in"
115 " MAXVAL intrinsic: is %ld, should be %ld",
116 (long int) (GFC_DESCRIPTOR_RANK (retarray)),
117 (long int) rank);
119 if (unlikely (compile_options.bounds_check))
120 bounds_ifunction_return ((array_t *) retarray, extent,
121 "return value", "MAXVAL");
124 for (n = 0; n < rank; n++)
126 count[n] = 0;
127 dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
128 if (extent[n] <= 0)
129 return;
132 base = array->base_addr;
133 dest = retarray->base_addr;
135 continue_loop = 1;
136 while (continue_loop)
138 const GFC_INTEGER_4 * restrict src;
139 GFC_INTEGER_4 result;
140 src = base;
143 #if defined (GFC_INTEGER_4_INFINITY)
144 result = -GFC_INTEGER_4_INFINITY;
145 #else
146 result = (-GFC_INTEGER_4_HUGE-1);
147 #endif
148 if (len <= 0)
149 *dest = (-GFC_INTEGER_4_HUGE-1);
150 else
152 for (n = 0; n < len; n++, src += delta)
155 #if defined (GFC_INTEGER_4_QUIET_NAN)
156 if (*src >= result)
157 break;
159 if (unlikely (n >= len))
160 result = GFC_INTEGER_4_QUIET_NAN;
161 else for (; n < len; n++, src += delta)
163 #endif
164 if (*src > result)
165 result = *src;
168 *dest = result;
171 /* Advance to the next element. */
172 count[0]++;
173 base += sstride[0];
174 dest += dstride[0];
175 n = 0;
176 while (count[n] == extent[n])
178 /* When we get to the end of a dimension, reset it and increment
179 the next dimension. */
180 count[n] = 0;
181 /* We could precalculate these products, but this is a less
182 frequently used path so probably not worth it. */
183 base -= sstride[n] * extent[n];
184 dest -= dstride[n] * extent[n];
185 n++;
186 if (n == rank)
188 /* Break out of the look. */
189 continue_loop = 0;
190 break;
192 else
194 count[n]++;
195 base += sstride[n];
196 dest += dstride[n];
203 extern void mmaxval_i4 (gfc_array_i4 * const restrict,
204 gfc_array_i4 * const restrict, const index_type * const restrict,
205 gfc_array_l1 * const restrict);
206 export_proto(mmaxval_i4);
208 void
209 mmaxval_i4 (gfc_array_i4 * const restrict retarray,
210 gfc_array_i4 * const restrict array,
211 const index_type * const restrict pdim,
212 gfc_array_l1 * const restrict mask)
214 index_type count[GFC_MAX_DIMENSIONS];
215 index_type extent[GFC_MAX_DIMENSIONS];
216 index_type sstride[GFC_MAX_DIMENSIONS];
217 index_type dstride[GFC_MAX_DIMENSIONS];
218 index_type mstride[GFC_MAX_DIMENSIONS];
219 GFC_INTEGER_4 * restrict dest;
220 const GFC_INTEGER_4 * restrict base;
221 const GFC_LOGICAL_1 * restrict mbase;
222 int rank;
223 int dim;
224 index_type n;
225 index_type len;
226 index_type delta;
227 index_type mdelta;
228 int mask_kind;
230 dim = (*pdim) - 1;
231 rank = GFC_DESCRIPTOR_RANK (array) - 1;
233 len = GFC_DESCRIPTOR_EXTENT(array,dim);
234 if (len <= 0)
235 return;
237 mbase = mask->base_addr;
239 mask_kind = GFC_DESCRIPTOR_SIZE (mask);
241 if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
242 #ifdef HAVE_GFC_LOGICAL_16
243 || mask_kind == 16
244 #endif
246 mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
247 else
248 runtime_error ("Funny sized logical array");
250 delta = GFC_DESCRIPTOR_STRIDE(array,dim);
251 mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
253 for (n = 0; n < dim; n++)
255 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
256 mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
257 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
259 if (extent[n] < 0)
260 extent[n] = 0;
263 for (n = dim; n < rank; n++)
265 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
266 mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
267 extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
269 if (extent[n] < 0)
270 extent[n] = 0;
273 if (retarray->base_addr == NULL)
275 size_t alloc_size, str;
277 for (n = 0; n < rank; n++)
279 if (n == 0)
280 str = 1;
281 else
282 str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
284 GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
288 alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
290 retarray->offset = 0;
291 retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
293 if (alloc_size == 0)
295 /* Make sure we have a zero-sized array. */
296 GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
297 return;
299 else
300 retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
303 else
305 if (rank != GFC_DESCRIPTOR_RANK (retarray))
306 runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
308 if (unlikely (compile_options.bounds_check))
310 bounds_ifunction_return ((array_t *) retarray, extent,
311 "return value", "MAXVAL");
312 bounds_equal_extents ((array_t *) mask, (array_t *) array,
313 "MASK argument", "MAXVAL");
317 for (n = 0; n < rank; n++)
319 count[n] = 0;
320 dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
321 if (extent[n] <= 0)
322 return;
325 dest = retarray->base_addr;
326 base = array->base_addr;
328 while (base)
330 const GFC_INTEGER_4 * restrict src;
331 const GFC_LOGICAL_1 * restrict msrc;
332 GFC_INTEGER_4 result;
333 src = base;
334 msrc = mbase;
337 #if defined (GFC_INTEGER_4_INFINITY)
338 result = -GFC_INTEGER_4_INFINITY;
339 #else
340 result = (-GFC_INTEGER_4_HUGE-1);
341 #endif
342 #if defined (GFC_INTEGER_4_QUIET_NAN)
343 int non_empty_p = 0;
344 #endif
345 for (n = 0; n < len; n++, src += delta, msrc += mdelta)
348 #if defined (GFC_INTEGER_4_INFINITY) || defined (GFC_INTEGER_4_QUIET_NAN)
349 if (*msrc)
351 #if defined (GFC_INTEGER_4_QUIET_NAN)
352 non_empty_p = 1;
353 if (*src >= result)
354 #endif
355 break;
358 if (unlikely (n >= len))
360 #if defined (GFC_INTEGER_4_QUIET_NAN)
361 result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : (-GFC_INTEGER_4_HUGE-1);
362 #else
363 result = (-GFC_INTEGER_4_HUGE-1);
364 #endif
366 else for (; n < len; n++, src += delta, msrc += mdelta)
368 #endif
369 if (*msrc && *src > result)
370 result = *src;
372 *dest = result;
374 /* Advance to the next element. */
375 count[0]++;
376 base += sstride[0];
377 mbase += mstride[0];
378 dest += dstride[0];
379 n = 0;
380 while (count[n] == extent[n])
382 /* When we get to the end of a dimension, reset it and increment
383 the next dimension. */
384 count[n] = 0;
385 /* We could precalculate these products, but this is a less
386 frequently used path so probably not worth it. */
387 base -= sstride[n] * extent[n];
388 mbase -= mstride[n] * extent[n];
389 dest -= dstride[n] * extent[n];
390 n++;
391 if (n == rank)
393 /* Break out of the look. */
394 base = NULL;
395 break;
397 else
399 count[n]++;
400 base += sstride[n];
401 mbase += mstride[n];
402 dest += dstride[n];
409 extern void smaxval_i4 (gfc_array_i4 * const restrict,
410 gfc_array_i4 * const restrict, const index_type * const restrict,
411 GFC_LOGICAL_4 *);
412 export_proto(smaxval_i4);
414 void
415 smaxval_i4 (gfc_array_i4 * const restrict retarray,
416 gfc_array_i4 * const restrict array,
417 const index_type * const restrict pdim,
418 GFC_LOGICAL_4 * mask)
420 index_type count[GFC_MAX_DIMENSIONS];
421 index_type extent[GFC_MAX_DIMENSIONS];
422 index_type dstride[GFC_MAX_DIMENSIONS];
423 GFC_INTEGER_4 * restrict dest;
424 index_type rank;
425 index_type n;
426 index_type dim;
429 if (*mask)
431 maxval_i4 (retarray, array, pdim);
432 return;
434 /* Make dim zero based to avoid confusion. */
435 dim = (*pdim) - 1;
436 rank = GFC_DESCRIPTOR_RANK (array) - 1;
438 for (n = 0; n < dim; n++)
440 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
442 if (extent[n] <= 0)
443 extent[n] = 0;
446 for (n = dim; n < rank; n++)
448 extent[n] =
449 GFC_DESCRIPTOR_EXTENT(array,n + 1);
451 if (extent[n] <= 0)
452 extent[n] = 0;
455 if (retarray->base_addr == NULL)
457 size_t alloc_size, str;
459 for (n = 0; n < rank; n++)
461 if (n == 0)
462 str = 1;
463 else
464 str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
466 GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
470 retarray->offset = 0;
471 retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
473 alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
475 if (alloc_size == 0)
477 /* Make sure we have a zero-sized array. */
478 GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
479 return;
481 else
482 retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
484 else
486 if (rank != GFC_DESCRIPTOR_RANK (retarray))
487 runtime_error ("rank of return array incorrect in"
488 " MAXVAL intrinsic: is %ld, should be %ld",
489 (long int) (GFC_DESCRIPTOR_RANK (retarray)),
490 (long int) rank);
492 if (unlikely (compile_options.bounds_check))
494 for (n=0; n < rank; n++)
496 index_type ret_extent;
498 ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
499 if (extent[n] != ret_extent)
500 runtime_error ("Incorrect extent in return value of"
501 " MAXVAL intrinsic in dimension %ld:"
502 " is %ld, should be %ld", (long int) n + 1,
503 (long int) ret_extent, (long int) extent[n]);
508 for (n = 0; n < rank; n++)
510 count[n] = 0;
511 dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
514 dest = retarray->base_addr;
516 while(1)
518 *dest = (-GFC_INTEGER_4_HUGE-1);
519 count[0]++;
520 dest += dstride[0];
521 n = 0;
522 while (count[n] == extent[n])
524 /* When we get to the end of a dimension, reset it and increment
525 the next dimension. */
526 count[n] = 0;
527 /* We could precalculate these products, but this is a less
528 frequently used path so probably not worth it. */
529 dest -= dstride[n] * extent[n];
530 n++;
531 if (n == rank)
532 return;
533 else
535 count[n]++;
536 dest += dstride[n];
542 #endif