Fix addvdi3 and subvdi3 patterns
[official-gcc.git] / libgfortran / generated / maxval0_s1.c
blob9a3a508fa20514779b25873645c6dcabb9081ee0
1 /* Implementation of the MAXLOC intrinsic
2 Copyright (C) 2017-2022 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_UINTEGER_1) && defined (HAVE_GFC_UINTEGER_1)
35 static inline int
36 compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
38 if (sizeof (GFC_UINTEGER_1) == 1)
39 return memcmp (a, b, n);
40 else
41 return memcmp_char4 (a, b, n);
45 #define INITVAL 0
47 extern void maxval0_s1 (GFC_UINTEGER_1 * restrict,
48 gfc_charlen_type,
49 gfc_array_s1 * const restrict array, gfc_charlen_type);
50 export_proto(maxval0_s1);
52 void
53 maxval0_s1 (GFC_UINTEGER_1 * restrict ret,
54 gfc_charlen_type xlen,
55 gfc_array_s1 * const restrict array, gfc_charlen_type len)
57 index_type count[GFC_MAX_DIMENSIONS];
58 index_type extent[GFC_MAX_DIMENSIONS];
59 index_type sstride[GFC_MAX_DIMENSIONS];
60 const GFC_UINTEGER_1 *base;
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 assert (xlen == len);
70 /* Initialize return value. */
71 memset (ret, INITVAL, sizeof(*ret) * len);
73 for (n = 0; n < rank; n++)
75 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
76 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
77 count[n] = 0;
78 if (extent[n] <= 0)
79 return;
82 base = array->base_addr;
86 const GFC_UINTEGER_1 *retval;
87 retval = ret;
89 while (base)
93 /* Implementation start. */
95 if (compare_fcn (base, retval, len) > 0)
97 retval = base;
99 /* Implementation end. */
100 /* Advance to the next element. */
101 base += sstride[0];
103 while (++count[0] != extent[0]);
104 n = 0;
107 /* When we get to the end of a dimension, reset it and increment
108 the next dimension. */
109 count[n] = 0;
110 /* We could precalculate these products, but this is a less
111 frequently used path so probably not worth it. */
112 base -= sstride[n] * extent[n];
113 n++;
114 if (n >= rank)
116 /* Break out of the loop. */
117 base = NULL;
118 break;
120 else
122 count[n]++;
123 base += sstride[n];
126 while (count[n] == extent[n]);
128 memcpy (ret, retval, len * sizeof (*ret));
133 extern void mmaxval0_s1 (GFC_UINTEGER_1 * restrict,
134 gfc_charlen_type, gfc_array_s1 * const restrict array,
135 gfc_array_l1 * const restrict mask, gfc_charlen_type len);
136 export_proto(mmaxval0_s1);
138 void
139 mmaxval0_s1 (GFC_UINTEGER_1 * const restrict ret,
140 gfc_charlen_type xlen, gfc_array_s1 * const restrict array,
141 gfc_array_l1 * const restrict mask, gfc_charlen_type len)
143 index_type count[GFC_MAX_DIMENSIONS];
144 index_type extent[GFC_MAX_DIMENSIONS];
145 index_type sstride[GFC_MAX_DIMENSIONS];
146 index_type mstride[GFC_MAX_DIMENSIONS];
147 const GFC_UINTEGER_1 *base;
148 GFC_LOGICAL_1 *mbase;
149 int rank;
150 index_type n;
151 int mask_kind;
153 if (mask == NULL)
155 maxval0_s1 (ret, xlen, array, len);
156 return;
159 rank = GFC_DESCRIPTOR_RANK (array);
160 if (rank <= 0)
161 runtime_error ("Rank of array needs to be > 0");
163 assert (xlen == len);
165 /* Initialize return value. */
166 memset (ret, INITVAL, sizeof(*ret) * len);
168 mask_kind = GFC_DESCRIPTOR_SIZE (mask);
170 mbase = mask->base_addr;
172 if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
173 #ifdef HAVE_GFC_LOGICAL_16
174 || mask_kind == 16
175 #endif
177 mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
178 else
179 runtime_error ("Funny sized logical array");
181 for (n = 0; n < rank; n++)
183 sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
184 mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
185 extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
186 count[n] = 0;
187 if (extent[n] <= 0)
188 return;
191 base = array->base_addr;
194 const GFC_UINTEGER_1 *retval;
196 retval = ret;
198 while (base)
202 /* Implementation start. */
204 if (*mbase && compare_fcn (base, retval, len) > 0)
206 retval = base;
208 /* Implementation end. */
209 /* Advance to the next element. */
210 base += sstride[0];
211 mbase += mstride[0];
213 while (++count[0] != extent[0]);
214 n = 0;
217 /* When we get to the end of a dimension, reset it and increment
218 the next dimension. */
219 count[n] = 0;
220 /* We could precalculate these products, but this is a less
221 frequently used path so probably not worth it. */
222 base -= sstride[n] * extent[n];
223 mbase -= mstride[n] * extent[n];
224 n++;
225 if (n >= rank)
227 /* Break out of the loop. */
228 base = NULL;
229 break;
231 else
233 count[n]++;
234 base += sstride[n];
235 mbase += mstride[n];
238 while (count[n] == extent[n]);
240 memcpy (ret, retval, len * sizeof (*ret));
245 extern void smaxval0_s1 (GFC_UINTEGER_1 * restrict,
246 gfc_charlen_type,
247 gfc_array_s1 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type);
248 export_proto(smaxval0_s1);
250 void
251 smaxval0_s1 (GFC_UINTEGER_1 * restrict ret,
252 gfc_charlen_type xlen, gfc_array_s1 * const restrict array,
253 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
256 if (mask == NULL || *mask)
258 maxval0_s1 (ret, xlen, array, len);
259 return;
261 memset (ret, INITVAL, sizeof (*ret) * len);
264 #endif