C++: Fix crash in warn_for_memset within templates (PR c++/83814)
[official-gcc.git] / libgfortran / generated / minloc0_4_r4.c
blob1b85544a292f07530dc63134f42a4650f07c1c0a
1 /* Implementation of the MINLOC 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 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"
27 #include <assert.h>
30 #if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
33 extern void minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
34 gfc_array_r4 * const restrict array, GFC_LOGICAL_4);
35 export_proto(minloc0_4_r4);
37 void
38 minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
39 gfc_array_r4 * const restrict array, GFC_LOGICAL_4 back)
41 index_type count[GFC_MAX_DIMENSIONS];
42 index_type extent[GFC_MAX_DIMENSIONS];
43 index_type sstride[GFC_MAX_DIMENSIONS];
44 index_type dstride;
45 const GFC_REAL_4 *base;
46 GFC_INTEGER_4 * restrict dest;
47 index_type rank;
48 index_type n;
50 assert(back == 0);
51 rank = GFC_DESCRIPTOR_RANK (array);
52 if (rank <= 0)
53 runtime_error ("Rank of array needs to be > 0");
55 if (retarray->base_addr == NULL)
57 GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
58 GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
59 retarray->offset = 0;
60 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
62 else
64 if (unlikely (compile_options.bounds_check))
65 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
66 "MINLOC");
69 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
70 dest = retarray->base_addr;
71 for (n = 0; n < rank; n++)
73 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
74 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
75 count[n] = 0;
76 if (extent[n] <= 0)
78 /* Set the return value. */
79 for (n = 0; n < rank; n++)
80 dest[n * dstride] = 0;
81 return;
85 base = array->base_addr;
87 /* Initialize the return value. */
88 for (n = 0; n < rank; n++)
89 dest[n * dstride] = 1;
92 GFC_REAL_4 minval;
93 #if defined(GFC_REAL_4_QUIET_NAN)
94 int fast = 0;
95 #endif
97 #if defined(GFC_REAL_4_INFINITY)
98 minval = GFC_REAL_4_INFINITY;
99 #else
100 minval = GFC_REAL_4_HUGE;
101 #endif
102 while (base)
106 /* Implementation start. */
108 #if defined(GFC_REAL_4_QUIET_NAN)
110 while (0);
111 if (unlikely (!fast))
115 if (*base <= minval)
117 fast = 1;
118 minval = *base;
119 for (n = 0; n < rank; n++)
120 dest[n * dstride] = count[n] + 1;
121 break;
123 base += sstride[0];
125 while (++count[0] != extent[0]);
126 if (likely (fast))
127 continue;
129 else do
131 #endif
132 if (*base < minval)
134 minval = *base;
135 for (n = 0; n < rank; n++)
136 dest[n * dstride] = count[n] + 1;
138 /* Implementation end. */
139 /* Advance to the next element. */
140 base += sstride[0];
142 while (++count[0] != extent[0]);
143 n = 0;
146 /* When we get to the end of a dimension, reset it and increment
147 the next dimension. */
148 count[n] = 0;
149 /* We could precalculate these products, but this is a less
150 frequently used path so probably not worth it. */
151 base -= sstride[n] * extent[n];
152 n++;
153 if (n >= rank)
155 /* Break out of the loop. */
156 base = NULL;
157 break;
159 else
161 count[n]++;
162 base += sstride[n];
165 while (count[n] == extent[n]);
171 extern void mminloc0_4_r4 (gfc_array_i4 * const restrict,
172 gfc_array_r4 * const restrict, gfc_array_l1 * const restrict,
173 GFC_LOGICAL_4);
174 export_proto(mminloc0_4_r4);
176 void
177 mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
178 gfc_array_r4 * const restrict array,
179 gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
181 index_type count[GFC_MAX_DIMENSIONS];
182 index_type extent[GFC_MAX_DIMENSIONS];
183 index_type sstride[GFC_MAX_DIMENSIONS];
184 index_type mstride[GFC_MAX_DIMENSIONS];
185 index_type dstride;
186 GFC_INTEGER_4 *dest;
187 const GFC_REAL_4 *base;
188 GFC_LOGICAL_1 *mbase;
189 int rank;
190 index_type n;
191 int mask_kind;
193 assert(back == 0);
194 rank = GFC_DESCRIPTOR_RANK (array);
195 if (rank <= 0)
196 runtime_error ("Rank of array needs to be > 0");
198 if (retarray->base_addr == NULL)
200 GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
201 GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
202 retarray->offset = 0;
203 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
205 else
207 if (unlikely (compile_options.bounds_check))
210 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
211 "MINLOC");
212 bounds_equal_extents ((array_t *) mask, (array_t *) array,
213 "MASK argument", "MINLOC");
217 mask_kind = GFC_DESCRIPTOR_SIZE (mask);
219 mbase = mask->base_addr;
221 if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
222 #ifdef HAVE_GFC_LOGICAL_16
223 || mask_kind == 16
224 #endif
226 mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
227 else
228 runtime_error ("Funny sized logical array");
230 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
231 dest = retarray->base_addr;
232 for (n = 0; n < rank; n++)
234 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
235 mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
236 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
237 count[n] = 0;
238 if (extent[n] <= 0)
240 /* Set the return value. */
241 for (n = 0; n < rank; n++)
242 dest[n * dstride] = 0;
243 return;
247 base = array->base_addr;
249 /* Initialize the return value. */
250 for (n = 0; n < rank; n++)
251 dest[n * dstride] = 0;
254 GFC_REAL_4 minval;
255 int fast = 0;
257 #if defined(GFC_REAL_4_INFINITY)
258 minval = GFC_REAL_4_INFINITY;
259 #else
260 minval = GFC_REAL_4_HUGE;
261 #endif
262 while (base)
266 /* Implementation start. */
269 while (0);
270 if (unlikely (!fast))
274 if (*mbase)
276 #if defined(GFC_REAL_4_QUIET_NAN)
277 if (unlikely (dest[0] == 0))
278 for (n = 0; n < rank; n++)
279 dest[n * dstride] = count[n] + 1;
280 if (*base <= minval)
281 #endif
283 fast = 1;
284 minval = *base;
285 for (n = 0; n < rank; n++)
286 dest[n * dstride] = count[n] + 1;
287 break;
290 base += sstride[0];
291 mbase += mstride[0];
293 while (++count[0] != extent[0]);
294 if (likely (fast))
295 continue;
297 else do
299 if (*mbase && *base < minval)
301 minval = *base;
302 for (n = 0; n < rank; n++)
303 dest[n * dstride] = count[n] + 1;
305 /* Implementation end. */
306 /* Advance to the next element. */
307 base += sstride[0];
308 mbase += mstride[0];
310 while (++count[0] != extent[0]);
311 n = 0;
314 /* When we get to the end of a dimension, reset it and increment
315 the next dimension. */
316 count[n] = 0;
317 /* We could precalculate these products, but this is a less
318 frequently used path so probably not worth it. */
319 base -= sstride[n] * extent[n];
320 mbase -= mstride[n] * extent[n];
321 n++;
322 if (n >= rank)
324 /* Break out of the loop. */
325 base = NULL;
326 break;
328 else
330 count[n]++;
331 base += sstride[n];
332 mbase += mstride[n];
335 while (count[n] == extent[n]);
341 extern void sminloc0_4_r4 (gfc_array_i4 * const restrict,
342 gfc_array_r4 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
343 export_proto(sminloc0_4_r4);
345 void
346 sminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
347 gfc_array_r4 * const restrict array,
348 GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
350 index_type rank;
351 index_type dstride;
352 index_type n;
353 GFC_INTEGER_4 *dest;
355 if (*mask)
357 minloc0_4_r4 (retarray, array, back);
358 return;
361 rank = GFC_DESCRIPTOR_RANK (array);
363 if (rank <= 0)
364 runtime_error ("Rank of array needs to be > 0");
366 if (retarray->base_addr == NULL)
368 GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
369 GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
370 retarray->offset = 0;
371 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
373 else if (unlikely (compile_options.bounds_check))
375 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
376 "MINLOC");
379 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
380 dest = retarray->base_addr;
381 for (n = 0; n<rank; n++)
382 dest[n * dstride] = 0 ;
384 #endif