/* Implementation of the MAXLOC intrinsic
- Copyright 2017 Free Software Foundation, Inc.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
+#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
-extern GFC_INTEGER_16 maxloc2_16_s4 (gfc_array_s4 * const restrict,
+extern GFC_INTEGER_16 maxloc2_16_s4 (gfc_array_s4 * const restrict, GFC_LOGICAL_4 back,
gfc_charlen_type);
export_proto(maxloc2_16_s4);
GFC_INTEGER_16
-maxloc2_16_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
+maxloc2_16_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
ret = 1;
src = array->base_addr;
- maxval = src;
- for (i=2; i<=extent; i++)
+ maxval = NULL;
+ for (i=1; i<=extent; i++)
{
- src += sstride;
- if (compare_fcn (src, maxval, len) > 0)
+ if (maxval == NULL || (back ? compare_fcn (src, maxval, len) >= 0 :
+ compare_fcn (src, maxval, len) > 0))
{
ret = i;
maxval = src;
}
+ src += sstride;
}
return ret;
}
extern GFC_INTEGER_16 mmaxloc2_16_s4 (gfc_array_s4 * const restrict,
- gfc_array_l1 *const restrict mask, gfc_charlen_type);
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type);
export_proto(mmaxloc2_16_s4);
GFC_INTEGER_16
mmaxloc2_16_s4 (gfc_array_s4 * const restrict array,
- gfc_array_l1 * const restrict mask,
+ gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
for (i=j+1; i<=extent; i++)
{
- if (*mbase && compare_fcn (src, maxval, len) > 0)
+ if (*mbase && (back ? compare_fcn (src, maxval, len) >= 0 :
+ compare_fcn (src, maxval, len) > 0))
{
ret = i;
maxval = src;
}
extern GFC_INTEGER_16 smaxloc2_16_s4 (gfc_array_s4 * const restrict,
- GFC_LOGICAL_4 *mask, gfc_charlen_type);
+ GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back, gfc_charlen_type);
export_proto(smaxloc2_16_s4);
GFC_INTEGER_16
smaxloc2_16_s4 (gfc_array_s4 * const restrict array,
- GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+ GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back, gfc_charlen_type len)
{
if (mask)
- return maxloc2_16_s4 (array, len);
+ return maxloc2_16_s4 (array, len, back);
else
return 0;
}