/* Implementation of the MINLOC intrinsic
- Copyright (C) 2017-2018 Free Software Foundation, Inc.
+ Copyright (C) 2017-2024 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+
+#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_8_s1 (gfc_array_i8 * const restrict retarray,
- gfc_array_s1 * const restrict array, gfc_charlen_type len);
+ gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back, gfc_charlen_type len);
export_proto(minloc0_8_s1);
void
minloc0_8_s1 (gfc_array_i8 * const restrict retarray,
- gfc_array_s1 * const restrict array, gfc_charlen_type len)
+ gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
- GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
+ retarray->dtype.rank = 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *minval;
- minval = base;
+ const GFC_UINTEGER_1 *minval;
+ minval = NULL;
while (base)
{
{
/* Implementation start. */
- if (compare_fcn (base, minval, len) < 0)
+ if (minval == NULL || (back ? compare_fcn (base, minval, len) <= 0 :
+ compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
extern void mminloc0_8_s1 (gfc_array_i8 * const restrict,
- gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+ gfc_array_s1 * const restrict, gfc_array_l1 * const restrict , GFC_LOGICAL_4 back,
+ gfc_charlen_type len);
export_proto(mminloc0_8_s1);
void
mminloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
- gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+ gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
+ if (mask == NULL)
+ {
+#ifdef HAVE_BACK_ARG
+ minloc0_8_s1 (retarray, array, back, len);
+#else
+ minloc0_8_s1 (retarray, array, len);
+#endif
+ return;
+ }
+
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
- GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
+ retarray->dtype.rank = 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
{
/* Implementation start. */
- if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+ if (*mbase &&
+ (minval == NULL || (back ? compare_fcn (base, minval, len) <= 0 :
+ compare_fcn (base, minval, len) < 0)))
{
minval = base;
for (n = 0; n < rank; n++)
extern void sminloc0_8_s1 (gfc_array_i8 * const restrict,
- gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+ gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4 back,
+ gfc_charlen_type len);
export_proto(sminloc0_8_s1);
void
sminloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
- GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_8 *dest;
- if (*mask)
+ if (mask == NULL || *mask)
{
+#ifdef HAVE_BACK_ARG
+ minloc0_8_s1 (retarray, array, back, len);
+#else
minloc0_8_s1 (retarray, array, len);
+#endif
return;
}
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
- GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
+ retarray->dtype.rank = 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}