/* Implementation of the MINLOC intrinsic
- Copyright (C) 2002-2018 Free Software Foundation, Inc.
+ Copyright (C) 2002-2024 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran runtime library (libgfortran).
index_type dim;
int continue_loop;
-#ifdef HAVE_BACK_ARG
- assert(back == 0);
-#endif
-
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
}
retarray->offset = 0;
- GFC_DTYPE_COPY_SETRANK(retarray,array,rank);
+ retarray->dtype.rank = rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
- {
- /* Make sure we have a zero-sized array. */
- GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
- return;
-
- }
+ return;
}
else
{
*dest = 0;
else
{
+#if ! defined HAVE_BACK_ARG
for (n = 0; n < len; n++, src += delta)
{
+#endif
#if defined (GFC_INTEGER_2_QUIET_NAN)
+ for (n = 0; n < len; n++, src += delta)
+ {
if (*src <= minval)
{
minval = *src;
break;
}
}
- for (; n < len; n++, src += delta)
- {
+#else
+ n = 0;
#endif
- if (*src < minval)
- {
- minval = *src;
- result = (GFC_INTEGER_8)n + 1;
- }
+ if (back)
+ for (; n < len; n++, src += delta)
+ {
+ if (unlikely (*src <= minval))
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ else
+ for (; n < len; n++, src += delta)
+ {
+ if (unlikely (*src < minval))
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8) n + 1;
+ }
}
*dest = result;
index_type mdelta;
int mask_kind;
+ if (mask == NULL)
+ {
#ifdef HAVE_BACK_ARG
- assert (back == 0);
+ minloc1_8_i2 (retarray, array, pdim, back);
+#else
+ minloc1_8_i2 (retarray, array, pdim);
#endif
+ return;
+ }
+
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
- if (len <= 0)
- return;
+ if (len < 0)
+ len = 0;
mbase = mask->base_addr;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
- GFC_DTYPE_COPY_SETRANK(retarray,array,rank);
+ retarray->dtype.rank = rank;
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
- {
- /* Make sure we have a zero-sized array. */
- GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
- return;
- }
- else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
-
+ return;
}
else
{
result = result2;
else
#endif
- for (; n < len; n++, src += delta, msrc += mdelta)
- {
- if (*msrc && *src < minval)
+ if (back)
+ for (; n < len; n++, src += delta, msrc += mdelta)
+ {
+ if (*msrc && unlikely (*src <= minval))
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ else
+ for (; n < len; n++, src += delta, msrc += mdelta)
{
- minval = *src;
- result = (GFC_INTEGER_8)n + 1;
- }
+ if (*msrc && unlikely (*src < minval))
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8) n + 1;
+ }
}
*dest = result;
}
index_type dim;
- if (*mask)
+ if (mask == NULL || *mask)
{
#ifdef HAVE_BACK_ARG
minloc1_8_i2 (retarray, array, pdim, back);
}
retarray->offset = 0;
- GFC_DTYPE_COPY_SETRANK(retarray,array,rank);
+ retarray->dtype.rank = rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
- {
- /* Make sure we have a zero-sized array. */
- GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
- return;
- }
- else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
+ return;
}
else
{