PR middle-end/81463
[official-gcc.git] / libgfortran / generated / minloc0_8_i2.c
blob936cdf5d8d7771feeca8fe57e1a9ef1f2dc17184
1 /* Implementation of the MINLOC intrinsic
2 Copyright (C) 2002-2017 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
5 This file is part of the GNU Fortran 95 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"
29 #if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_8)
32 extern void minloc0_8_i2 (gfc_array_i8 * const restrict retarray,
33 gfc_array_i2 * const restrict array);
34 export_proto(minloc0_8_i2);
36 void
37 minloc0_8_i2 (gfc_array_i8 * const restrict retarray,
38 gfc_array_i2 * const restrict array)
40 index_type count[GFC_MAX_DIMENSIONS];
41 index_type extent[GFC_MAX_DIMENSIONS];
42 index_type sstride[GFC_MAX_DIMENSIONS];
43 index_type dstride;
44 const GFC_INTEGER_2 *base;
45 GFC_INTEGER_8 * restrict dest;
46 index_type rank;
47 index_type n;
49 rank = GFC_DESCRIPTOR_RANK (array);
50 if (rank <= 0)
51 runtime_error ("Rank of array needs to be > 0");
53 if (retarray->base_addr == NULL)
55 GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
56 retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
57 retarray->offset = 0;
58 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
60 else
62 if (unlikely (compile_options.bounds_check))
63 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
64 "MINLOC");
67 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
68 dest = retarray->base_addr;
69 for (n = 0; n < rank; n++)
71 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
72 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
73 count[n] = 0;
74 if (extent[n] <= 0)
76 /* Set the return value. */
77 for (n = 0; n < rank; n++)
78 dest[n * dstride] = 0;
79 return;
83 base = array->base_addr;
85 /* Initialize the return value. */
86 for (n = 0; n < rank; n++)
87 dest[n * dstride] = 1;
90 GFC_INTEGER_2 minval;
91 #if defined(GFC_INTEGER_2_QUIET_NAN)
92 int fast = 0;
93 #endif
95 #if defined(GFC_INTEGER_2_INFINITY)
96 minval = GFC_INTEGER_2_INFINITY;
97 #else
98 minval = GFC_INTEGER_2_HUGE;
99 #endif
100 while (base)
104 /* Implementation start. */
106 #if defined(GFC_INTEGER_2_QUIET_NAN)
108 while (0);
109 if (unlikely (!fast))
113 if (*base <= minval)
115 fast = 1;
116 minval = *base;
117 for (n = 0; n < rank; n++)
118 dest[n * dstride] = count[n] + 1;
119 break;
121 base += sstride[0];
123 while (++count[0] != extent[0]);
124 if (likely (fast))
125 continue;
127 else do
129 #endif
130 if (*base < minval)
132 minval = *base;
133 for (n = 0; n < rank; n++)
134 dest[n * dstride] = count[n] + 1;
136 /* Implementation end. */
137 /* Advance to the next element. */
138 base += sstride[0];
140 while (++count[0] != extent[0]);
141 n = 0;
144 /* When we get to the end of a dimension, reset it and increment
145 the next dimension. */
146 count[n] = 0;
147 /* We could precalculate these products, but this is a less
148 frequently used path so probably not worth it. */
149 base -= sstride[n] * extent[n];
150 n++;
151 if (n >= rank)
153 /* Break out of the loop. */
154 base = NULL;
155 break;
157 else
159 count[n]++;
160 base += sstride[n];
163 while (count[n] == extent[n]);
169 extern void mminloc0_8_i2 (gfc_array_i8 * const restrict,
170 gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
171 export_proto(mminloc0_8_i2);
173 void
174 mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
175 gfc_array_i2 * const restrict array,
176 gfc_array_l1 * const restrict mask)
178 index_type count[GFC_MAX_DIMENSIONS];
179 index_type extent[GFC_MAX_DIMENSIONS];
180 index_type sstride[GFC_MAX_DIMENSIONS];
181 index_type mstride[GFC_MAX_DIMENSIONS];
182 index_type dstride;
183 GFC_INTEGER_8 *dest;
184 const GFC_INTEGER_2 *base;
185 GFC_LOGICAL_1 *mbase;
186 int rank;
187 index_type n;
188 int mask_kind;
190 rank = GFC_DESCRIPTOR_RANK (array);
191 if (rank <= 0)
192 runtime_error ("Rank of array needs to be > 0");
194 if (retarray->base_addr == NULL)
196 GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
197 retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
198 retarray->offset = 0;
199 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
201 else
203 if (unlikely (compile_options.bounds_check))
206 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
207 "MINLOC");
208 bounds_equal_extents ((array_t *) mask, (array_t *) array,
209 "MASK argument", "MINLOC");
213 mask_kind = GFC_DESCRIPTOR_SIZE (mask);
215 mbase = mask->base_addr;
217 if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
218 #ifdef HAVE_GFC_LOGICAL_16
219 || mask_kind == 16
220 #endif
222 mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
223 else
224 runtime_error ("Funny sized logical array");
226 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
227 dest = retarray->base_addr;
228 for (n = 0; n < rank; n++)
230 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
231 mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
232 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
233 count[n] = 0;
234 if (extent[n] <= 0)
236 /* Set the return value. */
237 for (n = 0; n < rank; n++)
238 dest[n * dstride] = 0;
239 return;
243 base = array->base_addr;
245 /* Initialize the return value. */
246 for (n = 0; n < rank; n++)
247 dest[n * dstride] = 0;
250 GFC_INTEGER_2 minval;
251 int fast = 0;
253 #if defined(GFC_INTEGER_2_INFINITY)
254 minval = GFC_INTEGER_2_INFINITY;
255 #else
256 minval = GFC_INTEGER_2_HUGE;
257 #endif
258 while (base)
262 /* Implementation start. */
265 while (0);
266 if (unlikely (!fast))
270 if (*mbase)
272 #if defined(GFC_INTEGER_2_QUIET_NAN)
273 if (unlikely (dest[0] == 0))
274 for (n = 0; n < rank; n++)
275 dest[n * dstride] = count[n] + 1;
276 if (*base <= minval)
277 #endif
279 fast = 1;
280 minval = *base;
281 for (n = 0; n < rank; n++)
282 dest[n * dstride] = count[n] + 1;
283 break;
286 base += sstride[0];
287 mbase += mstride[0];
289 while (++count[0] != extent[0]);
290 if (likely (fast))
291 continue;
293 else do
295 if (*mbase && *base < minval)
297 minval = *base;
298 for (n = 0; n < rank; n++)
299 dest[n * dstride] = count[n] + 1;
301 /* Implementation end. */
302 /* Advance to the next element. */
303 base += sstride[0];
304 mbase += mstride[0];
306 while (++count[0] != extent[0]);
307 n = 0;
310 /* When we get to the end of a dimension, reset it and increment
311 the next dimension. */
312 count[n] = 0;
313 /* We could precalculate these products, but this is a less
314 frequently used path so probably not worth it. */
315 base -= sstride[n] * extent[n];
316 mbase -= mstride[n] * extent[n];
317 n++;
318 if (n >= rank)
320 /* Break out of the loop. */
321 base = NULL;
322 break;
324 else
326 count[n]++;
327 base += sstride[n];
328 mbase += mstride[n];
331 while (count[n] == extent[n]);
337 extern void sminloc0_8_i2 (gfc_array_i8 * const restrict,
338 gfc_array_i2 * const restrict, GFC_LOGICAL_4 *);
339 export_proto(sminloc0_8_i2);
341 void
342 sminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
343 gfc_array_i2 * const restrict array,
344 GFC_LOGICAL_4 * mask)
346 index_type rank;
347 index_type dstride;
348 index_type n;
349 GFC_INTEGER_8 *dest;
351 if (*mask)
353 minloc0_8_i2 (retarray, array);
354 return;
357 rank = GFC_DESCRIPTOR_RANK (array);
359 if (rank <= 0)
360 runtime_error ("Rank of array needs to be > 0");
362 if (retarray->base_addr == NULL)
364 GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
365 retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
366 retarray->offset = 0;
367 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
369 else if (unlikely (compile_options.bounds_check))
371 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
372 "MINLOC");
375 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
376 dest = retarray->base_addr;
377 for (n = 0; n<rank; n++)
378 dest[n * dstride] = 0 ;
380 #endif