/* Implementation of the MAXLOC intrinsic
- Copyright (C) 2002-2017 Free Software Foundation, Inc.
+ Copyright (C) 2002-2021 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran runtime library (libgfortran).
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
+#include <assert.h>
#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_4)
+#define HAVE_BACK_ARG 1
+
extern void maxloc1_4_i2 (gfc_array_i4 * const restrict,
- gfc_array_i2 * const restrict, const index_type * const restrict);
+ gfc_array_i2 * const restrict, const index_type * const restrict, GFC_LOGICAL_4 back);
export_proto(maxloc1_4_i2);
void
maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
gfc_array_i2 * const restrict array,
- const index_type * const restrict pdim)
+ const index_type * const restrict pdim, GFC_LOGICAL_4 back)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
}
retarray->offset = 0;
- retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ retarray->dtype.rank = rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
*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 >= maxval)
{
maxval = *src;
break;
}
}
+#else
+ n = 0;
+#endif
for (; n < len; n++, src += delta)
{
-#endif
- if (*src > maxval)
+ if (back ? *src >= maxval : *src > maxval)
{
maxval = *src;
result = (GFC_INTEGER_4)n + 1;
extern void mmaxloc1_4_i2 (gfc_array_i4 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict,
- gfc_array_l1 * const restrict);
+ gfc_array_l1 * const restrict, GFC_LOGICAL_4 back);
export_proto(mmaxloc1_4_i2);
void
mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
gfc_array_i2 * const restrict array,
const index_type * const restrict pdim,
- gfc_array_l1 * const restrict mask)
+ gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type mdelta;
int mask_kind;
+ if (mask == NULL)
+ {
+#ifdef HAVE_BACK_ARG
+ maxloc1_4_i2 (retarray, array, pdim, back);
+#else
+ maxloc1_4_i2 (retarray, array, pdim);
+#endif
+ return;
+ }
+
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
- retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ retarray->dtype.rank = rank;
if (alloc_size == 0)
{
result = result2;
else
#endif
- for (; n < len; n++, src += delta, msrc += mdelta)
- {
- if (*msrc && *src > maxval)
- {
- maxval = *src;
- result = (GFC_INTEGER_4)n + 1;
- }
+ if (back)
+ for (; n < len; n++, src += delta, msrc += mdelta)
+ {
+ if (*msrc && unlikely (*src >= maxval))
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ else
+ for (; n < len; n++, src += delta, msrc += mdelta)
+ {
+ if (*msrc && unlikely (*src > maxval))
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
}
*dest = result;
}
extern void smaxloc1_4_i2 (gfc_array_i4 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict,
- GFC_LOGICAL_4 *);
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4 back);
export_proto(smaxloc1_4_i2);
void
smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
gfc_array_i2 * const restrict array,
const index_type * const restrict pdim,
- GFC_LOGICAL_4 * mask)
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dim;
- if (*mask)
+ if (mask == NULL || *mask)
{
+#ifdef HAVE_BACK_ARG
+ maxloc1_4_i2 (retarray, array, pdim, back);
+#else
maxloc1_4_i2 (retarray, array, pdim);
+#endif
return;
}
/* Make dim zero based to avoid confusion. */
}
retarray->offset = 0;
- retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ retarray->dtype.rank = rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];