PR c/86453 - error: type variant differs by TYPE_PACKED in free_lang_data since r255469
[official-gcc.git] / libgfortran / generated / minloc0_8_s4.c
blob15871ca324a30e87b0b9a4133422497ff1ddd210
1 /* Implementation of the MINLOC intrinsic
2 Copyright (C) 2017-2018 Free Software Foundation, Inc.
3 Contributed by Thomas Koenig
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 <string.h>
29 #include <assert.h>
30 #include <limits.h>
33 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
35 #define HAVE_BACK_ARG 1
37 static inline int
38 compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
40 if (sizeof (GFC_INTEGER_4) == 1)
41 return memcmp (a, b, n);
42 else
43 return memcmp_char4 (a, b, n);
47 extern void minloc0_8_s4 (gfc_array_i8 * const restrict retarray,
48 gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back, gfc_charlen_type len);
49 export_proto(minloc0_8_s4);
51 void
52 minloc0_8_s4 (gfc_array_i8 * const restrict retarray,
53 gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back, gfc_charlen_type len)
55 index_type count[GFC_MAX_DIMENSIONS];
56 index_type extent[GFC_MAX_DIMENSIONS];
57 index_type sstride[GFC_MAX_DIMENSIONS];
58 index_type dstride;
59 const GFC_INTEGER_4 *base;
60 GFC_INTEGER_8 * restrict dest;
61 index_type rank;
62 index_type n;
64 rank = GFC_DESCRIPTOR_RANK (array);
65 if (rank <= 0)
66 runtime_error ("Rank of array needs to be > 0");
68 if (retarray->base_addr == NULL)
70 GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
71 retarray->dtype.rank = 1;
72 retarray->offset = 0;
73 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
75 else
77 if (unlikely (compile_options.bounds_check))
78 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
79 "MINLOC");
82 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
83 dest = retarray->base_addr;
84 for (n = 0; n < rank; n++)
86 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
87 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
88 count[n] = 0;
89 if (extent[n] <= 0)
91 /* Set the return value. */
92 for (n = 0; n < rank; n++)
93 dest[n * dstride] = 0;
94 return;
98 base = array->base_addr;
100 /* Initialize the return value. */
101 for (n = 0; n < rank; n++)
102 dest[n * dstride] = 1;
105 const GFC_INTEGER_4 *minval;
106 minval = NULL;
108 while (base)
112 /* Implementation start. */
114 if (minval == NULL || (back ? compare_fcn (base, minval, len) <= 0 :
115 compare_fcn (base, minval, len) < 0))
117 minval = base;
118 for (n = 0; n < rank; n++)
119 dest[n * dstride] = count[n] + 1;
121 /* Implementation end. */
122 /* Advance to the next element. */
123 base += sstride[0];
125 while (++count[0] != extent[0]);
126 n = 0;
129 /* When we get to the end of a dimension, reset it and increment
130 the next dimension. */
131 count[n] = 0;
132 /* We could precalculate these products, but this is a less
133 frequently used path so probably not worth it. */
134 base -= sstride[n] * extent[n];
135 n++;
136 if (n >= rank)
138 /* Break out of the loop. */
139 base = NULL;
140 break;
142 else
144 count[n]++;
145 base += sstride[n];
148 while (count[n] == extent[n]);
154 extern void mminloc0_8_s4 (gfc_array_i8 * const restrict,
155 gfc_array_s4 * const restrict, gfc_array_l1 * const restrict , GFC_LOGICAL_4 back,
156 gfc_charlen_type len);
157 export_proto(mminloc0_8_s4);
159 void
160 mminloc0_8_s4 (gfc_array_i8 * const restrict retarray,
161 gfc_array_s4 * const restrict array,
162 gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back,
163 gfc_charlen_type len)
165 index_type count[GFC_MAX_DIMENSIONS];
166 index_type extent[GFC_MAX_DIMENSIONS];
167 index_type sstride[GFC_MAX_DIMENSIONS];
168 index_type mstride[GFC_MAX_DIMENSIONS];
169 index_type dstride;
170 GFC_INTEGER_8 *dest;
171 const GFC_INTEGER_4 *base;
172 GFC_LOGICAL_1 *mbase;
173 int rank;
174 index_type n;
175 int mask_kind;
177 rank = GFC_DESCRIPTOR_RANK (array);
178 if (rank <= 0)
179 runtime_error ("Rank of array needs to be > 0");
181 if (retarray->base_addr == NULL)
183 GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
184 retarray->dtype.rank = 1;
185 retarray->offset = 0;
186 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
188 else
190 if (unlikely (compile_options.bounds_check))
193 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
194 "MINLOC");
195 bounds_equal_extents ((array_t *) mask, (array_t *) array,
196 "MASK argument", "MINLOC");
200 mask_kind = GFC_DESCRIPTOR_SIZE (mask);
202 mbase = mask->base_addr;
204 if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
205 #ifdef HAVE_GFC_LOGICAL_16
206 || mask_kind == 16
207 #endif
209 mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
210 else
211 runtime_error ("Funny sized logical array");
213 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
214 dest = retarray->base_addr;
215 for (n = 0; n < rank; n++)
217 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
218 mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
219 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
220 count[n] = 0;
221 if (extent[n] <= 0)
223 /* Set the return value. */
224 for (n = 0; n < rank; n++)
225 dest[n * dstride] = 0;
226 return;
230 base = array->base_addr;
232 /* Initialize the return value. */
233 for (n = 0; n < rank; n++)
234 dest[n * dstride] = 0;
237 const GFC_INTEGER_4 *minval;
239 minval = NULL;
241 while (base)
245 /* Implementation start. */
247 if (*mbase &&
248 (minval == NULL || (back ? compare_fcn (base, minval, len) <= 0 :
249 compare_fcn (base, minval, len) < 0)))
251 minval = base;
252 for (n = 0; n < rank; n++)
253 dest[n * dstride] = count[n] + 1;
255 /* Implementation end. */
256 /* Advance to the next element. */
257 base += sstride[0];
258 mbase += mstride[0];
260 while (++count[0] != extent[0]);
261 n = 0;
264 /* When we get to the end of a dimension, reset it and increment
265 the next dimension. */
266 count[n] = 0;
267 /* We could precalculate these products, but this is a less
268 frequently used path so probably not worth it. */
269 base -= sstride[n] * extent[n];
270 mbase -= mstride[n] * extent[n];
271 n++;
272 if (n >= rank)
274 /* Break out of the loop. */
275 base = NULL;
276 break;
278 else
280 count[n]++;
281 base += sstride[n];
282 mbase += mstride[n];
285 while (count[n] == extent[n]);
291 extern void sminloc0_8_s4 (gfc_array_i8 * const restrict,
292 gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4 back,
293 gfc_charlen_type len);
294 export_proto(sminloc0_8_s4);
296 void
297 sminloc0_8_s4 (gfc_array_i8 * const restrict retarray,
298 gfc_array_s4 * const restrict array,
299 GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back,
300 gfc_charlen_type len)
302 index_type rank;
303 index_type dstride;
304 index_type n;
305 GFC_INTEGER_8 *dest;
307 if (*mask)
309 #ifdef HAVE_BACK_ARG
310 minloc0_8_s4 (retarray, array, back, len);
311 #else
312 minloc0_8_s4 (retarray, array, len);
313 #endif
314 return;
317 rank = GFC_DESCRIPTOR_RANK (array);
319 if (rank <= 0)
320 runtime_error ("Rank of array needs to be > 0");
322 if (retarray->base_addr == NULL)
324 GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
325 retarray->dtype.rank = 1;
326 retarray->offset = 0;
327 retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
329 else if (unlikely (compile_options.bounds_check))
331 bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
332 "MINLOC");
335 dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
336 dest = retarray->base_addr;
337 for (n = 0; n<rank; n++)
338 dest[n * dstride] = 0 ;
340 #endif