[thirdparty/gcc.git] / libgfortran / generated / minval_i4.c

/* Implementation of the MINVAL intrinsic
   Copyright (C) 2002-2022 Free Software Foundation, Inc.
   Contributed by Paul Brook <paul@nowt.org>

This file is part of the GNU Fortran runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"


#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)


extern void minval_i4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, const index_type * const restrict);
export_proto(minval_i4);

void
minval_i4 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i4 * const restrict array, 
	const index_type * const restrict pdim)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  const GFC_INTEGER_4 * restrict base;
  GFC_INTEGER_4 * restrict dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;
  int continue_loop;

  /* Make dim zero based to avoid confusion.  */
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
  dim = (*pdim) - 1;

  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in MINVAL intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len < 0)
    len = 0;
  delta = GFC_DESCRIPTOR_STRIDE(array,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype.rank = rank;

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;

	}
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " MINVAL intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	bounds_ifunction_return ((array_t *) retarray, extent,
				 "return value", "MINVAL");
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  base = array->base_addr;
  dest = retarray->base_addr;

  continue_loop = 1;
  while (continue_loop)
    {
      const GFC_INTEGER_4 * restrict src;
      GFC_INTEGER_4 result;
      src = base;
      {

#if defined (GFC_INTEGER_4_INFINITY)
	result = GFC_INTEGER_4_INFINITY;
#else
	result = GFC_INTEGER_4_HUGE;
#endif
	if (len <= 0)
	  *dest = GFC_INTEGER_4_HUGE;
	else
	  {
#if ! defined HAVE_BACK_ARG
	    for (n = 0; n < len; n++, src += delta)
	      {
#endif

#if defined (GFC_INTEGER_4_QUIET_NAN)
		if (*src <= result)
		  break;
	      }
	    if (unlikely (n >= len))
	      result = GFC_INTEGER_4_QUIET_NAN;
	    else for (; n < len; n++, src += delta)
	      {
#endif
		if (*src < result)
		  result = *src;
	      }
	    
	    *dest = result;
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      dest += dstride[0];
      n = 0;
      while (count[n] == extent[n])
	{
	  /* When we get to the end of a dimension, reset it and increment
	     the next dimension.  */
	  count[n] = 0;
	  /* We could precalculate these products, but this is a less
	     frequently used path so probably not worth it.  */
	  base -= sstride[n] * extent[n];
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      continue_loop = 0;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      dest += dstride[n];
	    }
	}
    }
}


extern void mminval_i4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict);
export_proto(mminval_i4);

void
mminval_i4 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i4 * const restrict array, 
	const index_type * const restrict pdim, 
	gfc_array_l1 * const restrict mask)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_4 * restrict dest;
  const GFC_INTEGER_4 * restrict base;
  const GFC_LOGICAL_1 * restrict mbase;
  index_type rank;
  index_type dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;
  int mask_kind;

  if (mask == NULL)
    {
#ifdef HAVE_BACK_ARG
      minval_i4 (retarray, array, pdim, back);
#else
      minval_i4 (retarray, array, pdim);
#endif
      return;
    }

  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;


  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in MINVAL intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len <= 0)
    return;

  mbase = mask->base_addr;

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
      || mask_kind == 16
#endif
      )
    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
  else
    runtime_error ("Funny sized logical array");

  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;

    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      retarray->offset = 0;
      retarray->dtype.rank = rank;

      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_4));

    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in MINVAL intrinsic");

      if (unlikely (compile_options.bounds_check))
	{
	  bounds_ifunction_return ((array_t *) retarray, extent,
				   "return value", "MINVAL");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
	  			"MASK argument", "MINVAL");
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  dest = retarray->base_addr;
  base = array->base_addr;

  while (base)
    {
      const GFC_INTEGER_4 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_4 result;
      src = base;
      msrc = mbase;
      {

#if defined (GFC_INTEGER_4_INFINITY)
	result = GFC_INTEGER_4_INFINITY;
#else
	result = GFC_INTEGER_4_HUGE;
#endif
#if defined (GFC_INTEGER_4_QUIET_NAN)
	int non_empty_p = 0;
#endif
	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	  {

#if defined (GFC_INTEGER_4_INFINITY) || defined (GFC_INTEGER_4_QUIET_NAN)
		if (*msrc)
		  {
#if defined (GFC_INTEGER_4_QUIET_NAN)
		    non_empty_p = 1;
		    if (*src <= result)
#endif
		      break;
		  }
	      }
	    if (unlikely (n >= len))
	      {
#if defined (GFC_INTEGER_4_QUIET_NAN)
		result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : GFC_INTEGER_4_HUGE;
#else
		result = GFC_INTEGER_4_HUGE;
#endif
	      }
	    else for (; n < len; n++, src += delta, msrc += mdelta)
	      {
#endif
		if (*msrc && *src < result)
		  result = *src;
	  }
	*dest = result;
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[0];
      dest += dstride[0];
      n = 0;
      while (count[n] == extent[n])
	{
	  /* When we get to the end of a dimension, reset it and increment
	     the next dimension.  */
	  count[n] = 0;
	  /* We could precalculate these products, but this is a less
	     frequently used path so probably not worth it.  */
	  base -= sstride[n] * extent[n];
	  mbase -= mstride[n] * extent[n];
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      base = NULL;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      mbase += mstride[n];
	      dest += dstride[n];
	    }
	}
    }
}


extern void sminval_i4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(sminval_i4);

void
sminval_i4 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i4 * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_4 * restrict dest;
  index_type rank;
  index_type n;
  index_type dim;


  if (mask == NULL || *mask)
    {
#ifdef HAVE_BACK_ARG
      minval_i4 (retarray, array, pdim, back);
#else
      minval_i4 (retarray, array, pdim);
#endif
      return;
    }
  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in MINVAL intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  for (n = 0; n < dim; n++)
    {
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  for (n = dim; n < rank; n++)
    {
      extent[n] =
	GFC_DESCRIPTOR_EXTENT(array,n + 1);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype.rank = rank;

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      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_4));
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " MINVAL intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " MINVAL intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
    }

  dest = retarray->base_addr;

  while(1)
    {
      *dest = GFC_INTEGER_4_HUGE;
      count[0]++;
      dest += dstride[0];
      n = 0;
      while (count[n] == extent[n])
	{
	  /* When we get to the end of a dimension, reset it and increment
	     the next dimension.  */
	  count[n] = 0;
	  /* We could precalculate these products, but this is a less
	     frequently used path so probably not worth it.  */
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    return;
	  else
	    {
	      count[n]++;
	      dest += dstride[n];
	    }
      	}
    }
}

#endif
Commit	Line	Data
6de9cd9a	1	/* Implementation of the MINVAL intrinsic
7adcbafe	2	Copyright (C) 2002-2022 Free Software Foundation, Inc.
6de9cd9a DN	3	Contributed by Paul Brook <paul@nowt.org>
6de9cd9a DN	4
0cd0559e	5	This file is part of the GNU Fortran runtime library (libgfortran).
6de9cd9a DN	6
6de9cd9a DN	7	Libgfortran is free software; you can redistribute it and/or
57dea9f6	8	modify it under the terms of the GNU General Public
6de9cd9a	9	License as published by the Free Software Foundation; either
748086b7	10	version 3 of the License, or (at your option) any later version.
6de9cd9a DN	11
	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
57dea9f6	15	GNU General Public License for more details.
6de9cd9a	16
748086b7 JJ	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.
	20
	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/>. */
6de9cd9a	25
36ae8a61	26	#include "libgfortran.h"
6de9cd9a	27
7d7b8bfe	28
644cb69f FXC	29	#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
	30
	31
64acfd99 JB	32	extern void minval_i4 (gfc_array_i4 * const restrict,
64acfd99 JB	33	gfc_array_i4 * const restrict, const index_type * const restrict);
7f68c75f	34	export_proto(minval_i4);
7d7b8bfe	35
6de9cd9a	36	void
64acfd99 JB	37	minval_i4 (gfc_array_i4 * const restrict retarray,
	38	gfc_array_i4 * const restrict array,
	39	const index_type * const restrict pdim)
6de9cd9a	40	{
e33e218b TK	41	index_type count[GFC_MAX_DIMENSIONS];
	42	index_type extent[GFC_MAX_DIMENSIONS];
	43	index_type sstride[GFC_MAX_DIMENSIONS];
	44	index_type dstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	45	const GFC_INTEGER_4 * restrict base;
64acfd99 JB	46	GFC_INTEGER_4 * restrict dest;
6de9cd9a DN	47	index_type rank;
	48	index_type n;
	49	index_type len;
	50	index_type delta;
	51	index_type dim;
da96f5ab	52	int continue_loop;
6de9cd9a DN	53
6de9cd9a DN	54	/* Make dim zero based to avoid confusion. */
6de9cd9a	55	rank = GFC_DESCRIPTOR_RANK (array) - 1;
cfdf6ff6 TK	56	dim = (*pdim) - 1;
	57
	58	if (unlikely (dim < 0 \|\| dim > rank))
	59	{
	60	runtime_error ("Dim argument incorrect in MINVAL intrinsic: "
	61	"is %ld, should be between 1 and %ld",
	62	(long int) dim + 1, (long int) rank + 1);
	63	}
e33e218b	64
dfb55fdc	65	len = GFC_DESCRIPTOR_EXTENT(array,dim);
da96f5ab TK	66	if (len < 0)
da96f5ab TK	67	len = 0;
dfb55fdc	68	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
6de9cd9a DN	69
	70	for (n = 0; n < dim; n++)
	71	{
dfb55fdc TK	72	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	73	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
80ee04b9 TK	74
	75	if (extent[n] < 0)
	76	extent[n] = 0;
6de9cd9a DN	77	}
	78	for (n = dim; n < rank; n++)
	79	{
dfb55fdc TK	80	sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
dfb55fdc TK	81	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
80ee04b9 TK	82
	83	if (extent[n] < 0)
	84	extent[n] = 0;
6de9cd9a DN	85	}
6de9cd9a DN	86
21d1335b	87	if (retarray->base_addr == NULL)
6c167c45	88	{
dfb55fdc	89	size_t alloc_size, str;
80ee04b9	90
6c167c45	91	for (n = 0; n < rank; n++)
80927a56 JJ	92	{
80927a56 JJ	93	if (n == 0)
dfb55fdc	94	str = 1;
80927a56 JJ	95	else
80927a56 JJ	96	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
dfb55fdc TK	97
	98	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	99
80927a56	100	}
6c167c45	101
efd4dc1a	102	retarray->offset = 0;
ca708a2b	103	retarray->dtype.rank = rank;
80ee04b9	104
92e6f3a4	105	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
80ee04b9	106
92e6f3a4	107	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
80ee04b9 TK	108	if (alloc_size == 0)
	109	{
	110	/* Make sure we have a zero-sized array. */
dfb55fdc	111	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
80ee04b9	112	return;
dfb55fdc	113
80ee04b9	114	}
6c167c45	115	}
50dd63a9 TK	116	else
50dd63a9 TK	117	{
50dd63a9	118	if (rank != GFC_DESCRIPTOR_RANK (retarray))
fd6590f8	119	runtime_error ("rank of return array incorrect in"
ccacefc7 TK	120	" MINVAL intrinsic: is %ld, should be %ld",
	121	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	122	(long int) rank);
fd6590f8	123
9731c4a3	124	if (unlikely (compile_options.bounds_check))
16bff921 TK	125	bounds_ifunction_return ((array_t *) retarray, extent,
16bff921 TK	126	"return value", "MINVAL");
50dd63a9 TK	127	}
50dd63a9 TK	128
6de9cd9a DN	129	for (n = 0; n < rank; n++)
	130	{
	131	count[n] = 0;
dfb55fdc	132	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
6de9cd9a	133	if (extent[n] <= 0)
facc1285	134	return;
6de9cd9a DN	135	}
6de9cd9a DN	136
21d1335b TB	137	base = array->base_addr;
21d1335b TB	138	dest = retarray->base_addr;
6de9cd9a	139
da96f5ab TK	140	continue_loop = 1;
da96f5ab TK	141	while (continue_loop)
6de9cd9a	142	{
64acfd99	143	const GFC_INTEGER_4 * restrict src;
6de9cd9a DN	144	GFC_INTEGER_4 result;
	145	src = base;
	146	{
	147
80927a56 JJ	148	#if defined (GFC_INTEGER_4_INFINITY)
	149	result = GFC_INTEGER_4_INFINITY;
	150	#else
	151	result = GFC_INTEGER_4_HUGE;
	152	#endif
	153	if (len <= 0)
6de9cd9a DN	154	*dest = GFC_INTEGER_4_HUGE;
	155	else
	156	{
b573f931	157	#if ! defined HAVE_BACK_ARG
6de9cd9a DN	158	for (n = 0; n < len; n++, src += delta)
6de9cd9a DN	159	{
b573f931	160	#endif
6de9cd9a	161
80927a56 JJ	162	#if defined (GFC_INTEGER_4_QUIET_NAN)
	163	if (*src <= result)
	164	break;
	165	}
	166	if (unlikely (n >= len))
	167	result = GFC_INTEGER_4_QUIET_NAN;
	168	else for (; n < len; n++, src += delta)
	169	{
	170	#endif
	171	if (*src < result)
	172	result = *src;
	173	}
0cd0559e	174
6de9cd9a DN	175	*dest = result;
	176	}
	177	}
	178	/* Advance to the next element. */
	179	count[0]++;
	180	base += sstride[0];
	181	dest += dstride[0];
	182	n = 0;
	183	while (count[n] == extent[n])
80927a56 JJ	184	{
	185	/* When we get to the end of a dimension, reset it and increment
	186	the next dimension. */
	187	count[n] = 0;
	188	/* We could precalculate these products, but this is a less
	189	frequently used path so probably not worth it. */
	190	base -= sstride[n] * extent[n];
	191	dest -= dstride[n] * extent[n];
	192	n++;
80dd631f	193	if (n >= rank)
80927a56	194	{
80dd631f	195	/* Break out of the loop. */
da96f5ab TK	196	continue_loop = 0;
da96f5ab TK	197	break;
80927a56 JJ	198	}
	199	else
	200	{
	201	count[n]++;
	202	base += sstride[n];
	203	dest += dstride[n];
	204	}
	205	}
6de9cd9a DN	206	}
	207	}
	208
7d7b8bfe	209
64acfd99 JB	210	extern void mminval_i4 (gfc_array_i4 * const restrict,
64acfd99 JB	211	gfc_array_i4 * const restrict, const index_type * const restrict,
28dc6b33	212	gfc_array_l1 * const restrict);
7f68c75f	213	export_proto(mminval_i4);
7d7b8bfe	214
6de9cd9a	215	void
64acfd99 JB	216	mminval_i4 (gfc_array_i4 * const restrict retarray,
	217	gfc_array_i4 * const restrict array,
	218	const index_type * const restrict pdim,
28dc6b33	219	gfc_array_l1 * const restrict mask)
6de9cd9a	220	{
e33e218b TK	221	index_type count[GFC_MAX_DIMENSIONS];
	222	index_type extent[GFC_MAX_DIMENSIONS];
	223	index_type sstride[GFC_MAX_DIMENSIONS];
	224	index_type dstride[GFC_MAX_DIMENSIONS];
	225	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	226	GFC_INTEGER_4 * restrict dest;
64acfd99 JB	227	const GFC_INTEGER_4 * restrict base;
28dc6b33	228	const GFC_LOGICAL_1 * restrict mbase;
cfdf6ff6 TK	229	index_type rank;
cfdf6ff6 TK	230	index_type dim;
6de9cd9a DN	231	index_type n;
	232	index_type len;
	233	index_type delta;
	234	index_type mdelta;
28dc6b33	235	int mask_kind;
6de9cd9a	236
2ea47ee9 TK	237	if (mask == NULL)
	238	{
	239	#ifdef HAVE_BACK_ARG
	240	minval_i4 (retarray, array, pdim, back);
	241	#else
	242	minval_i4 (retarray, array, pdim);
	243	#endif
	244	return;
	245	}
	246
6de9cd9a DN	247	dim = (*pdim) - 1;
6de9cd9a DN	248	rank = GFC_DESCRIPTOR_RANK (array) - 1;
e33e218b	249
cfdf6ff6 TK	250
	251	if (unlikely (dim < 0 \|\| dim > rank))
	252	{
	253	runtime_error ("Dim argument incorrect in MINVAL intrinsic: "
	254	"is %ld, should be between 1 and %ld",
	255	(long int) dim + 1, (long int) rank + 1);
	256	}
	257
dfb55fdc	258	len = GFC_DESCRIPTOR_EXTENT(array,dim);
6de9cd9a DN	259	if (len <= 0)
6de9cd9a DN	260	return;
28dc6b33	261
21d1335b	262	mbase = mask->base_addr;
28dc6b33 TK	263
	264	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	265
	266	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	267	#ifdef HAVE_GFC_LOGICAL_16
	268	\|\| mask_kind == 16
	269	#endif
	270	)
	271	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	272	else
	273	runtime_error ("Funny sized logical array");
	274
dfb55fdc TK	275	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
dfb55fdc TK	276	mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
6de9cd9a DN	277
	278	for (n = 0; n < dim; n++)
	279	{
dfb55fdc TK	280	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	281	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	282	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
80ee04b9 TK	283
	284	if (extent[n] < 0)
	285	extent[n] = 0;
	286
6de9cd9a DN	287	}
	288	for (n = dim; n < rank; n++)
	289	{
dfb55fdc TK	290	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
	291	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
	292	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
80ee04b9 TK	293
	294	if (extent[n] < 0)
	295	extent[n] = 0;
6de9cd9a DN	296	}
6de9cd9a DN	297
21d1335b	298	if (retarray->base_addr == NULL)
50dd63a9	299	{
dfb55fdc	300	size_t alloc_size, str;
80ee04b9	301
50dd63a9	302	for (n = 0; n < rank; n++)
80927a56 JJ	303	{
	304	if (n == 0)
	305	str = 1;
	306	else
	307	str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
dfb55fdc TK	308
	309	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	310
80927a56	311	}
50dd63a9	312
92e6f3a4	313	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
80ee04b9	314
efd4dc1a	315	retarray->offset = 0;
ca708a2b	316	retarray->dtype.rank = rank;
80ee04b9 TK	317
	318	if (alloc_size == 0)
	319	{
	320	/* Make sure we have a zero-sized array. */
dfb55fdc	321	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
80ee04b9 TK	322	return;
	323	}
	324	else
92e6f3a4	325	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
80ee04b9	326
50dd63a9 TK	327	}
	328	else
	329	{
50dd63a9	330	if (rank != GFC_DESCRIPTOR_RANK (retarray))
fd6590f8 TK	331	runtime_error ("rank of return array incorrect in MINVAL intrinsic");
fd6590f8 TK	332
9731c4a3	333	if (unlikely (compile_options.bounds_check))
fd6590f8	334	{
16bff921 TK	335	bounds_ifunction_return ((array_t *) retarray, extent,
	336	"return value", "MINVAL");
	337	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	338	"MASK argument", "MINVAL");
fd6590f8	339	}
50dd63a9 TK	340	}
50dd63a9 TK	341
6de9cd9a DN	342	for (n = 0; n < rank; n++)
	343	{
	344	count[n] = 0;
dfb55fdc	345	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
6de9cd9a	346	if (extent[n] <= 0)
80927a56	347	return;
6de9cd9a DN	348	}
6de9cd9a DN	349
21d1335b TB	350	dest = retarray->base_addr;
21d1335b TB	351	base = array->base_addr;
6de9cd9a DN	352
	353	while (base)
	354	{
64acfd99	355	const GFC_INTEGER_4 * restrict src;
28dc6b33	356	const GFC_LOGICAL_1 * restrict msrc;
6de9cd9a DN	357	GFC_INTEGER_4 result;
	358	src = base;
	359	msrc = mbase;
	360	{
	361
80927a56 JJ	362	#if defined (GFC_INTEGER_4_INFINITY)
	363	result = GFC_INTEGER_4_INFINITY;
	364	#else
	365	result = GFC_INTEGER_4_HUGE;
	366	#endif
	367	#if defined (GFC_INTEGER_4_QUIET_NAN)
	368	int non_empty_p = 0;
	369	#endif
036e1775	370	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
6de9cd9a	371	{
6de9cd9a	372
80927a56 JJ	373	#if defined (GFC_INTEGER_4_INFINITY) \|\| defined (GFC_INTEGER_4_QUIET_NAN)
	374	if (*msrc)
	375	{
	376	#if defined (GFC_INTEGER_4_QUIET_NAN)
	377	non_empty_p = 1;
	378	if (*src <= result)
	379	#endif
	380	break;
	381	}
	382	}
	383	if (unlikely (n >= len))
	384	{
	385	#if defined (GFC_INTEGER_4_QUIET_NAN)
	386	result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : GFC_INTEGER_4_HUGE;
	387	#else
	388	result = GFC_INTEGER_4_HUGE;
	389	#endif
	390	}
	391	else for (; n < len; n++, src += delta, msrc += mdelta)
	392	{
	393	#endif
	394	if (msrc && src < result)
	395	result = *src;
6de9cd9a	396	}
036e1775	397	*dest = result;
6de9cd9a DN	398	}
	399	/* Advance to the next element. */
	400	count[0]++;
	401	base += sstride[0];
	402	mbase += mstride[0];
	403	dest += dstride[0];
	404	n = 0;
	405	while (count[n] == extent[n])
80927a56 JJ	406	{
	407	/* When we get to the end of a dimension, reset it and increment
	408	the next dimension. */
	409	count[n] = 0;
	410	/* We could precalculate these products, but this is a less
	411	frequently used path so probably not worth it. */
	412	base -= sstride[n] * extent[n];
	413	mbase -= mstride[n] * extent[n];
	414	dest -= dstride[n] * extent[n];
	415	n++;
80dd631f	416	if (n >= rank)
80927a56	417	{
80dd631f	418	/* Break out of the loop. */
80927a56 JJ	419	base = NULL;
	420	break;
	421	}
	422	else
	423	{
	424	count[n]++;
	425	base += sstride[n];
	426	mbase += mstride[n];
	427	dest += dstride[n];
	428	}
	429	}
6de9cd9a DN	430	}
	431	}
	432
97a62038 TK	433
	434	extern void sminval_i4 (gfc_array_i4 * const restrict,
	435	gfc_array_i4 * const restrict, const index_type * const restrict,
	436	GFC_LOGICAL_4 *);
	437	export_proto(sminval_i4);
	438
	439	void
	440	sminval_i4 (gfc_array_i4 * const restrict retarray,
	441	gfc_array_i4 * const restrict array,
	442	const index_type * const restrict pdim,
	443	GFC_LOGICAL_4 * mask)
	444	{
802367d7 TK	445	index_type count[GFC_MAX_DIMENSIONS];
802367d7 TK	446	index_type extent[GFC_MAX_DIMENSIONS];
802367d7 TK	447	index_type dstride[GFC_MAX_DIMENSIONS];
802367d7 TK	448	GFC_INTEGER_4 * restrict dest;
97a62038 TK	449	index_type rank;
97a62038 TK	450	index_type n;
802367d7 TK	451	index_type dim;
802367d7 TK	452
97a62038	453
2ea47ee9	454	if (mask == NULL \|\| *mask)
97a62038	455	{
64b1806b TK	456	#ifdef HAVE_BACK_ARG
	457	minval_i4 (retarray, array, pdim, back);
	458	#else
97a62038	459	minval_i4 (retarray, array, pdim);
64b1806b	460	#endif
97a62038 TK	461	return;
97a62038 TK	462	}
802367d7 TK	463	/* Make dim zero based to avoid confusion. */
	464	dim = (*pdim) - 1;
	465	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	466
cfdf6ff6 TK	467	if (unlikely (dim < 0 \|\| dim > rank))
	468	{
	469	runtime_error ("Dim argument incorrect in MINVAL intrinsic: "
	470	"is %ld, should be between 1 and %ld",
	471	(long int) dim + 1, (long int) rank + 1);
	472	}
	473
802367d7 TK	474	for (n = 0; n < dim; n++)
802367d7 TK	475	{
dfb55fdc	476	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
802367d7 TK	477
	478	if (extent[n] <= 0)
	479	extent[n] = 0;
	480	}
	481
	482	for (n = dim; n < rank; n++)
	483	{
802367d7	484	extent[n] =
80927a56	485	GFC_DESCRIPTOR_EXTENT(array,n + 1);
802367d7 TK	486
802367d7 TK	487	if (extent[n] <= 0)
80927a56	488	extent[n] = 0;
802367d7	489	}
97a62038	490
21d1335b	491	if (retarray->base_addr == NULL)
97a62038	492	{
dfb55fdc	493	size_t alloc_size, str;
802367d7 TK	494
802367d7 TK	495	for (n = 0; n < rank; n++)
80927a56 JJ	496	{
	497	if (n == 0)
	498	str = 1;
	499	else
	500	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
dfb55fdc TK	501
	502	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	503
80927a56	504	}
802367d7	505
97a62038	506	retarray->offset = 0;
ca708a2b	507	retarray->dtype.rank = rank;
802367d7	508
92e6f3a4	509	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
802367d7 TK	510
	511	if (alloc_size == 0)
	512	{
	513	/* Make sure we have a zero-sized array. */
dfb55fdc	514	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
802367d7 TK	515	return;
	516	}
	517	else
92e6f3a4	518	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
97a62038 TK	519	}
	520	else
	521	{
802367d7 TK	522	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	523	runtime_error ("rank of return array incorrect in"
	524	" MINVAL intrinsic: is %ld, should be %ld",
	525	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	526	(long int) rank);
	527
9731c4a3	528	if (unlikely (compile_options.bounds_check))
fd6590f8	529	{
802367d7 TK	530	for (n=0; n < rank; n++)
	531	{
	532	index_type ret_extent;
97a62038	533
dfb55fdc	534	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
802367d7 TK	535	if (extent[n] != ret_extent)
	536	runtime_error ("Incorrect extent in return value of"
	537	" MINVAL intrinsic in dimension %ld:"
	538	" is %ld, should be %ld", (long int) n + 1,
	539	(long int) ret_extent, (long int) extent[n]);
	540	}
fd6590f8 TK	541	}
fd6590f8 TK	542	}
97a62038	543
802367d7 TK	544	for (n = 0; n < rank; n++)
	545	{
	546	count[n] = 0;
dfb55fdc	547	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
802367d7 TK	548	}
802367d7 TK	549
21d1335b	550	dest = retarray->base_addr;
802367d7 TK	551
	552	while(1)
	553	{
	554	*dest = GFC_INTEGER_4_HUGE;
	555	count[0]++;
	556	dest += dstride[0];
	557	n = 0;
	558	while (count[n] == extent[n])
80927a56	559	{
802367d7	560	/* When we get to the end of a dimension, reset it and increment
80927a56 JJ	561	the next dimension. */
	562	count[n] = 0;
	563	/* We could precalculate these products, but this is a less
	564	frequently used path so probably not worth it. */
	565	dest -= dstride[n] * extent[n];
	566	n++;
80dd631f	567	if (n >= rank)
802367d7	568	return;
80927a56 JJ	569	else
	570	{
	571	count[n]++;
	572	dest += dstride[n];
	573	}
802367d7 TK	574	}
802367d7 TK	575	}
97a62038 TK	576	}
97a62038 TK	577
644cb69f	578	#endif