]>
git.ipfire.org Git - thirdparty/gcc.git/blob - libgfortran/generated/minloc0_16_i8.c
0bc2bccbd86b1535a863c461392f5841fdb7d423
1 /* Implementation of the MINLOC intrinsic
2 Copyright (C) 2002-2016 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"
30 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
33 extern void minloc0_16_i8 (gfc_array_i16
* const restrict retarray
,
34 gfc_array_i8
* const restrict array
);
35 export_proto(minloc0_16_i8
);
38 minloc0_16_i8 (gfc_array_i16
* const restrict retarray
,
39 gfc_array_i8
* const restrict array
)
41 index_type count
[GFC_MAX_DIMENSIONS
];
42 index_type extent
[GFC_MAX_DIMENSIONS
];
43 index_type sstride
[GFC_MAX_DIMENSIONS
];
45 const GFC_INTEGER_8
*base
;
46 GFC_INTEGER_16
* restrict dest
;
50 rank
= GFC_DESCRIPTOR_RANK (array
);
52 runtime_error ("Rank of array needs to be > 0");
54 if (retarray
->base_addr
== NULL
)
56 GFC_DIMENSION_SET(retarray
->dim
[0], 0, rank
-1, 1);
57 retarray
->dtype
= (retarray
->dtype
& ~GFC_DTYPE_RANK_MASK
) | 1;
59 retarray
->base_addr
= xmallocarray (rank
, sizeof (GFC_INTEGER_16
));
63 if (unlikely (compile_options
.bounds_check
))
64 bounds_iforeach_return ((array_t
*) retarray
, (array_t
*) array
,
68 dstride
= GFC_DESCRIPTOR_STRIDE(retarray
,0);
69 dest
= retarray
->base_addr
;
70 for (n
= 0; n
< rank
; n
++)
72 sstride
[n
] = GFC_DESCRIPTOR_STRIDE(array
,n
);
73 extent
[n
] = GFC_DESCRIPTOR_EXTENT(array
,n
);
77 /* Set the return value. */
78 for (n
= 0; n
< rank
; n
++)
79 dest
[n
* dstride
] = 0;
84 base
= array
->base_addr
;
86 /* Initialize the return value. */
87 for (n
= 0; n
< rank
; n
++)
88 dest
[n
* dstride
] = 1;
92 #if defined(GFC_INTEGER_8_QUIET_NAN)
96 #if defined(GFC_INTEGER_8_INFINITY)
97 minval
= GFC_INTEGER_8_INFINITY
;
99 minval
= GFC_INTEGER_8_HUGE
;
105 /* Implementation start. */
107 #if defined(GFC_INTEGER_8_QUIET_NAN)
110 if (unlikely (!fast
))
118 for (n
= 0; n
< rank
; n
++)
119 dest
[n
* dstride
] = count
[n
] + 1;
124 while (++count
[0] != extent
[0]);
134 for (n
= 0; n
< rank
; n
++)
135 dest
[n
* dstride
] = count
[n
] + 1;
137 /* Implementation end. */
138 /* Advance to the next element. */
141 while (++count
[0] != extent
[0]);
145 /* When we get to the end of a dimension, reset it and increment
146 the next dimension. */
148 /* We could precalculate these products, but this is a less
149 frequently used path so probably not worth it. */
150 base
-= sstride
[n
] * extent
[n
];
154 /* Break out of the loop. */
164 while (count
[n
] == extent
[n
]);
170 extern void mminloc0_16_i8 (gfc_array_i16
* const restrict
,
171 gfc_array_i8
* const restrict
, gfc_array_l1
* const restrict
);
172 export_proto(mminloc0_16_i8
);
175 mminloc0_16_i8 (gfc_array_i16
* const restrict retarray
,
176 gfc_array_i8
* const restrict array
,
177 gfc_array_l1
* const restrict mask
)
179 index_type count
[GFC_MAX_DIMENSIONS
];
180 index_type extent
[GFC_MAX_DIMENSIONS
];
181 index_type sstride
[GFC_MAX_DIMENSIONS
];
182 index_type mstride
[GFC_MAX_DIMENSIONS
];
184 GFC_INTEGER_16
*dest
;
185 const GFC_INTEGER_8
*base
;
186 GFC_LOGICAL_1
*mbase
;
191 rank
= GFC_DESCRIPTOR_RANK (array
);
193 runtime_error ("Rank of array needs to be > 0");
195 if (retarray
->base_addr
== NULL
)
197 GFC_DIMENSION_SET(retarray
->dim
[0], 0, rank
- 1, 1);
198 retarray
->dtype
= (retarray
->dtype
& ~GFC_DTYPE_RANK_MASK
) | 1;
199 retarray
->offset
= 0;
200 retarray
->base_addr
= xmallocarray (rank
, sizeof (GFC_INTEGER_16
));
204 if (unlikely (compile_options
.bounds_check
))
207 bounds_iforeach_return ((array_t
*) retarray
, (array_t
*) array
,
209 bounds_equal_extents ((array_t
*) mask
, (array_t
*) array
,
210 "MASK argument", "MINLOC");
214 mask_kind
= GFC_DESCRIPTOR_SIZE (mask
);
216 mbase
= mask
->base_addr
;
218 if (mask_kind
== 1 || mask_kind
== 2 || mask_kind
== 4 || mask_kind
== 8
219 #ifdef HAVE_GFC_LOGICAL_16
223 mbase
= GFOR_POINTER_TO_L1 (mbase
, mask_kind
);
225 runtime_error ("Funny sized logical array");
227 dstride
= GFC_DESCRIPTOR_STRIDE(retarray
,0);
228 dest
= retarray
->base_addr
;
229 for (n
= 0; n
< rank
; n
++)
231 sstride
[n
] = GFC_DESCRIPTOR_STRIDE(array
,n
);
232 mstride
[n
] = GFC_DESCRIPTOR_STRIDE_BYTES(mask
,n
);
233 extent
[n
] = GFC_DESCRIPTOR_EXTENT(array
,n
);
237 /* Set the return value. */
238 for (n
= 0; n
< rank
; n
++)
239 dest
[n
* dstride
] = 0;
244 base
= array
->base_addr
;
246 /* Initialize the return value. */
247 for (n
= 0; n
< rank
; n
++)
248 dest
[n
* dstride
] = 0;
251 GFC_INTEGER_8 minval
;
254 #if defined(GFC_INTEGER_8_INFINITY)
255 minval
= GFC_INTEGER_8_INFINITY
;
257 minval
= GFC_INTEGER_8_HUGE
;
263 /* Implementation start. */
267 if (unlikely (!fast
))
273 #if defined(GFC_INTEGER_8_QUIET_NAN)
274 if (unlikely (dest
[0] == 0))
275 for (n
= 0; n
< rank
; n
++)
276 dest
[n
* dstride
] = count
[n
] + 1;
282 for (n
= 0; n
< rank
; n
++)
283 dest
[n
* dstride
] = count
[n
] + 1;
290 while (++count
[0] != extent
[0]);
296 if (*mbase
&& *base
< minval
)
299 for (n
= 0; n
< rank
; n
++)
300 dest
[n
* dstride
] = count
[n
] + 1;
302 /* Implementation end. */
303 /* Advance to the next element. */
307 while (++count
[0] != extent
[0]);
311 /* When we get to the end of a dimension, reset it and increment
312 the next dimension. */
314 /* We could precalculate these products, but this is a less
315 frequently used path so probably not worth it. */
316 base
-= sstride
[n
] * extent
[n
];
317 mbase
-= mstride
[n
] * extent
[n
];
321 /* Break out of the loop. */
332 while (count
[n
] == extent
[n
]);
338 extern void sminloc0_16_i8 (gfc_array_i16
* const restrict
,
339 gfc_array_i8
* const restrict
, GFC_LOGICAL_4
*);
340 export_proto(sminloc0_16_i8
);
343 sminloc0_16_i8 (gfc_array_i16
* const restrict retarray
,
344 gfc_array_i8
* const restrict array
,
345 GFC_LOGICAL_4
* mask
)
350 GFC_INTEGER_16
*dest
;
354 minloc0_16_i8 (retarray
, array
);
358 rank
= GFC_DESCRIPTOR_RANK (array
);
361 runtime_error ("Rank of array needs to be > 0");
363 if (retarray
->base_addr
== NULL
)
365 GFC_DIMENSION_SET(retarray
->dim
[0], 0, rank
-1, 1);
366 retarray
->dtype
= (retarray
->dtype
& ~GFC_DTYPE_RANK_MASK
) | 1;
367 retarray
->offset
= 0;
368 retarray
->base_addr
= xmallocarray (rank
, sizeof (GFC_INTEGER_16
));
370 else if (unlikely (compile_options
.bounds_check
))
372 bounds_iforeach_return ((array_t
*) retarray
, (array_t
*) array
,
376 dstride
= GFC_DESCRIPTOR_STRIDE(retarray
,0);
377 dest
= retarray
->base_addr
;
378 for (n
= 0; n
<rank
; n
++)
379 dest
[n
* dstride
] = 0 ;