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

/* Implementation of the MINVAL intrinsic
   Copyright (C) 2002-2019 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_8) && defined (HAVE_GFC_INTEGER_8)


extern void minval_i8 (gfc_array_i8 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict);
export_proto(minval_i8);

void
minval_i8 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i8 * 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_8 * restrict base;
  GFC_INTEGER_8 * 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_8));
      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_8 * restrict src;
      GFC_INTEGER_8 result;
      src = base;
      {

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

#if defined (GFC_INTEGER_8_QUIET_NAN)
		if (*src <= result)
		  break;
	      }
	    if (unlikely (n >= len))
	      result = GFC_INTEGER_8_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_i8 (gfc_array_i8 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict);
export_proto(mminval_i8);

void
mminval_i8 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i8 * 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_8 * restrict dest;
  const GFC_INTEGER_8 * 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_i8 (retarray, array, pdim, back);
#else
      minval_i8 (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_8));

    }
  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_8 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_8 result;
      src = base;
      msrc = mbase;
      {

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

#if defined (GFC_INTEGER_8_INFINITY) || defined (GFC_INTEGER_8_QUIET_NAN)
		if (*msrc)
		  {
#if defined (GFC_INTEGER_8_QUIET_NAN)
		    non_empty_p = 1;
		    if (*src <= result)
#endif
		      break;
		  }
	      }
	    if (unlikely (n >= len))
	      {
#if defined (GFC_INTEGER_8_QUIET_NAN)
		result = non_empty_p ? GFC_INTEGER_8_QUIET_NAN : GFC_INTEGER_8_HUGE;
#else
		result = GFC_INTEGER_8_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_i8 (gfc_array_i8 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(sminval_i8);

void
sminval_i8 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i8 * 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_8 * restrict dest;
  index_type rank;
  index_type n;
  index_type dim;


  if (mask == NULL || *mask)
    {
#ifdef HAVE_BACK_ARG
      minval_i8 (retarray, array, pdim, back);
#else
      minval_i8 (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_8));
    }
  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_8_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
4ee9c684	1	/* Implementation of the MINVAL intrinsic
fbd26352	2	Copyright (C) 2002-2019 Free Software Foundation, Inc.
4ee9c684	3	Contributed by Paul Brook <paul@nowt.org>
4ee9c684	4
b4ba8232	5	This file is part of the GNU Fortran runtime library (libgfortran).
4ee9c684	6
4ee9c684	7	Libgfortran is free software; you can redistribute it and/or
b417ea8c	8	modify it under the terms of the GNU General Public
4ee9c684	9	License as published by the Free Software Foundation; either
6bc9506f	10	version 3 of the License, or (at your option) any later version.
4ee9c684	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
b417ea8c	15	GNU General Public License for more details.
4ee9c684	16
6bc9506f	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/>. */
4ee9c684	25
41f2d5e8	26	#include "libgfortran.h"
4ee9c684	27
7b6cb5bd	28
920e54ef	29	#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
	30
	31
b4cafd67	32	extern void minval_i8 (gfc_array_i8 * const restrict,
b4cafd67	33	gfc_array_i8 * const restrict, const index_type * const restrict);
820b4fbd	34	export_proto(minval_i8);
7b6cb5bd	35
4ee9c684	36	void
b4cafd67	37	minval_i8 (gfc_array_i8 * const restrict retarray,
	38	gfc_array_i8 * const restrict array,
	39	const index_type * const restrict pdim)
4ee9c684	40	{
9130521e	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];
b4cafd67	45	const GFC_INTEGER_8 * restrict base;
b4cafd67	46	GFC_INTEGER_8 * restrict dest;
4ee9c684	47	index_type rank;
	48	index_type n;
	49	index_type len;
	50	index_type delta;
	51	index_type dim;
393a1b6c	52	int continue_loop;
4ee9c684	53
4ee9c684	54	/* Make dim zero based to avoid confusion. */
4ee9c684	55	rank = GFC_DESCRIPTOR_RANK (array) - 1;
3a33b9df	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	}
9130521e	64
827aef63	65	len = GFC_DESCRIPTOR_EXTENT(array,dim);
393a1b6c	66	if (len < 0)
393a1b6c	67	len = 0;
827aef63	68	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
4ee9c684	69
	70	for (n = 0; n < dim; n++)
	71	{
827aef63	72	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
827aef63	73	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
a14c06e9	74
	75	if (extent[n] < 0)
	76	extent[n] = 0;
4ee9c684	77	}
	78	for (n = dim; n < rank; n++)
	79	{
827aef63	80	sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
827aef63	81	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
a14c06e9	82
	83	if (extent[n] < 0)
	84	extent[n] = 0;
4ee9c684	85	}
4ee9c684	86
553877d9	87	if (retarray->base_addr == NULL)
5fcc57ce	88	{
827aef63	89	size_t alloc_size, str;
a14c06e9	90
5fcc57ce	91	for (n = 0; n < rank; n++)
7ebee933	92	{
7ebee933	93	if (n == 0)
827aef63	94	str = 1;
7ebee933	95	else
7ebee933	96	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
827aef63	97
	98	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	99
7ebee933	100	}
5fcc57ce	101
93830de1	102	retarray->offset = 0;
0bb0be20	103	retarray->dtype.rank = rank;
a14c06e9	104
af1e9051	105	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
a14c06e9	106
af1e9051	107	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
a14c06e9	108	if (alloc_size == 0)
	109	{
	110	/* Make sure we have a zero-sized array. */
827aef63	111	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
a14c06e9	112	return;
827aef63	113
a14c06e9	114	}
5fcc57ce	115	}
07ea8faa	116	else
07ea8faa	117	{
07ea8faa	118	if (rank != GFC_DESCRIPTOR_RANK (retarray))
8dec97a0	119	runtime_error ("rank of return array incorrect in"
ae66f8f3	120	" MINVAL intrinsic: is %ld, should be %ld",
	121	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	122	(long int) rank);
8dec97a0	123
c7fb575f	124	if (unlikely (compile_options.bounds_check))
5d04d450	125	bounds_ifunction_return ((array_t *) retarray, extent,
5d04d450	126	"return value", "MINVAL");
07ea8faa	127	}
07ea8faa	128
4ee9c684	129	for (n = 0; n < rank; n++)
	130	{
	131	count[n] = 0;
827aef63	132	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
4ee9c684	133	if (extent[n] <= 0)
7cbf86e5	134	return;
4ee9c684	135	}
4ee9c684	136
553877d9	137	base = array->base_addr;
553877d9	138	dest = retarray->base_addr;
4ee9c684	139
393a1b6c	140	continue_loop = 1;
393a1b6c	141	while (continue_loop)
4ee9c684	142	{
b4cafd67	143	const GFC_INTEGER_8 * restrict src;
4ee9c684	144	GFC_INTEGER_8 result;
	145	src = base;
	146	{
	147
7ebee933	148	#if defined (GFC_INTEGER_8_INFINITY)
	149	result = GFC_INTEGER_8_INFINITY;
	150	#else
	151	result = GFC_INTEGER_8_HUGE;
	152	#endif
	153	if (len <= 0)
4ee9c684	154	*dest = GFC_INTEGER_8_HUGE;
	155	else
	156	{
ca96069a	157	#if ! defined HAVE_BACK_ARG
4ee9c684	158	for (n = 0; n < len; n++, src += delta)
4ee9c684	159	{
ca96069a	160	#endif
4ee9c684	161
7ebee933	162	#if defined (GFC_INTEGER_8_QUIET_NAN)
	163	if (*src <= result)
	164	break;
	165	}
	166	if (unlikely (n >= len))
	167	result = GFC_INTEGER_8_QUIET_NAN;
	168	else for (; n < len; n++, src += delta)
	169	{
	170	#endif
	171	if (*src < result)
	172	result = *src;
	173	}
b4ba8232	174
4ee9c684	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])
7ebee933	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++;
bacde0a1	193	if (n >= rank)
7ebee933	194	{
bacde0a1	195	/* Break out of the loop. */
393a1b6c	196	continue_loop = 0;
393a1b6c	197	break;
7ebee933	198	}
	199	else
	200	{
	201	count[n]++;
	202	base += sstride[n];
	203	dest += dstride[n];
	204	}
	205	}
4ee9c684	206	}
	207	}
	208
7b6cb5bd	209
b4cafd67	210	extern void mminval_i8 (gfc_array_i8 * const restrict,
b4cafd67	211	gfc_array_i8 * const restrict, const index_type * const restrict,
7ed8f627	212	gfc_array_l1 * const restrict);
820b4fbd	213	export_proto(mminval_i8);
7b6cb5bd	214
4ee9c684	215	void
b4cafd67	216	mminval_i8 (gfc_array_i8 * const restrict retarray,
	217	gfc_array_i8 * const restrict array,
	218	const index_type * const restrict pdim,
7ed8f627	219	gfc_array_l1 * const restrict mask)
4ee9c684	220	{
9130521e	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];
b4cafd67	226	GFC_INTEGER_8 * restrict dest;
b4cafd67	227	const GFC_INTEGER_8 * restrict base;
7ed8f627	228	const GFC_LOGICAL_1 * restrict mbase;
3a33b9df	229	index_type rank;
3a33b9df	230	index_type dim;
4ee9c684	231	index_type n;
	232	index_type len;
	233	index_type delta;
	234	index_type mdelta;
7ed8f627	235	int mask_kind;
4ee9c684	236
538bdcdc	237	if (mask == NULL)
	238	{
	239	#ifdef HAVE_BACK_ARG
	240	minval_i8 (retarray, array, pdim, back);
	241	#else
	242	minval_i8 (retarray, array, pdim);
	243	#endif
	244	return;
	245	}
	246
4ee9c684	247	dim = (*pdim) - 1;
4ee9c684	248	rank = GFC_DESCRIPTOR_RANK (array) - 1;
9130521e	249
3a33b9df	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
827aef63	258	len = GFC_DESCRIPTOR_EXTENT(array,dim);
4ee9c684	259	if (len <= 0)
4ee9c684	260	return;
7ed8f627	261
553877d9	262	mbase = mask->base_addr;
7ed8f627	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
827aef63	275	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
827aef63	276	mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
4ee9c684	277
	278	for (n = 0; n < dim; n++)
	279	{
827aef63	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);
a14c06e9	283
	284	if (extent[n] < 0)
	285	extent[n] = 0;
	286
4ee9c684	287	}
	288	for (n = dim; n < rank; n++)
	289	{
827aef63	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);
a14c06e9	293
	294	if (extent[n] < 0)
	295	extent[n] = 0;
4ee9c684	296	}
4ee9c684	297
553877d9	298	if (retarray->base_addr == NULL)
07ea8faa	299	{
827aef63	300	size_t alloc_size, str;
a14c06e9	301
07ea8faa	302	for (n = 0; n < rank; n++)
7ebee933	303	{
	304	if (n == 0)
	305	str = 1;
	306	else
	307	str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
827aef63	308
	309	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	310
7ebee933	311	}
07ea8faa	312
af1e9051	313	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
a14c06e9	314
93830de1	315	retarray->offset = 0;
0bb0be20	316	retarray->dtype.rank = rank;
a14c06e9	317
	318	if (alloc_size == 0)
	319	{
	320	/* Make sure we have a zero-sized array. */
827aef63	321	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
a14c06e9	322	return;
	323	}
	324	else
af1e9051	325	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
a14c06e9	326
07ea8faa	327	}
	328	else
	329	{
07ea8faa	330	if (rank != GFC_DESCRIPTOR_RANK (retarray))
8dec97a0	331	runtime_error ("rank of return array incorrect in MINVAL intrinsic");
8dec97a0	332
c7fb575f	333	if (unlikely (compile_options.bounds_check))
8dec97a0	334	{
5d04d450	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");
8dec97a0	339	}
07ea8faa	340	}
07ea8faa	341
4ee9c684	342	for (n = 0; n < rank; n++)
	343	{
	344	count[n] = 0;
827aef63	345	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
4ee9c684	346	if (extent[n] <= 0)
7ebee933	347	return;
4ee9c684	348	}
4ee9c684	349
553877d9	350	dest = retarray->base_addr;
553877d9	351	base = array->base_addr;
4ee9c684	352
	353	while (base)
	354	{
b4cafd67	355	const GFC_INTEGER_8 * restrict src;
7ed8f627	356	const GFC_LOGICAL_1 * restrict msrc;
4ee9c684	357	GFC_INTEGER_8 result;
	358	src = base;
	359	msrc = mbase;
	360	{
	361
7ebee933	362	#if defined (GFC_INTEGER_8_INFINITY)
	363	result = GFC_INTEGER_8_INFINITY;
	364	#else
	365	result = GFC_INTEGER_8_HUGE;
	366	#endif
	367	#if defined (GFC_INTEGER_8_QUIET_NAN)
	368	int non_empty_p = 0;
	369	#endif
08e1eb56	370	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
4ee9c684	371	{
4ee9c684	372
7ebee933	373	#if defined (GFC_INTEGER_8_INFINITY) \|\| defined (GFC_INTEGER_8_QUIET_NAN)
	374	if (*msrc)
	375	{
	376	#if defined (GFC_INTEGER_8_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_8_QUIET_NAN)
	386	result = non_empty_p ? GFC_INTEGER_8_QUIET_NAN : GFC_INTEGER_8_HUGE;
	387	#else
	388	result = GFC_INTEGER_8_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;
4ee9c684	396	}
08e1eb56	397	*dest = result;
4ee9c684	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])
7ebee933	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++;
bacde0a1	416	if (n >= rank)
7ebee933	417	{
bacde0a1	418	/* Break out of the loop. */
7ebee933	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	}
4ee9c684	430	}
	431	}
	432
4292b27d	433
	434	extern void sminval_i8 (gfc_array_i8 * const restrict,
	435	gfc_array_i8 * const restrict, const index_type * const restrict,
	436	GFC_LOGICAL_4 *);
	437	export_proto(sminval_i8);
	438
	439	void
	440	sminval_i8 (gfc_array_i8 * const restrict retarray,
	441	gfc_array_i8 * const restrict array,
	442	const index_type * const restrict pdim,
	443	GFC_LOGICAL_4 * mask)
	444	{
f955bfc4	445	index_type count[GFC_MAX_DIMENSIONS];
f955bfc4	446	index_type extent[GFC_MAX_DIMENSIONS];
f955bfc4	447	index_type dstride[GFC_MAX_DIMENSIONS];
f955bfc4	448	GFC_INTEGER_8 * restrict dest;
4292b27d	449	index_type rank;
4292b27d	450	index_type n;
f955bfc4	451	index_type dim;
f955bfc4	452
4292b27d	453
538bdcdc	454	if (mask == NULL \|\| *mask)
4292b27d	455	{
cb458068	456	#ifdef HAVE_BACK_ARG
	457	minval_i8 (retarray, array, pdim, back);
	458	#else
4292b27d	459	minval_i8 (retarray, array, pdim);
cb458068	460	#endif
4292b27d	461	return;
4292b27d	462	}
f955bfc4	463	/* Make dim zero based to avoid confusion. */
	464	dim = (*pdim) - 1;
	465	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	466
3a33b9df	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
f955bfc4	474	for (n = 0; n < dim; n++)
f955bfc4	475	{
827aef63	476	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
f955bfc4	477
	478	if (extent[n] <= 0)
	479	extent[n] = 0;
	480	}
	481
	482	for (n = dim; n < rank; n++)
	483	{
f955bfc4	484	extent[n] =
7ebee933	485	GFC_DESCRIPTOR_EXTENT(array,n + 1);
f955bfc4	486
f955bfc4	487	if (extent[n] <= 0)
7ebee933	488	extent[n] = 0;
f955bfc4	489	}
4292b27d	490
553877d9	491	if (retarray->base_addr == NULL)
4292b27d	492	{
827aef63	493	size_t alloc_size, str;
f955bfc4	494
f955bfc4	495	for (n = 0; n < rank; n++)
7ebee933	496	{
	497	if (n == 0)
	498	str = 1;
	499	else
	500	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
827aef63	501
	502	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	503
7ebee933	504	}
f955bfc4	505
4292b27d	506	retarray->offset = 0;
0bb0be20	507	retarray->dtype.rank = rank;
f955bfc4	508
af1e9051	509	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
f955bfc4	510
	511	if (alloc_size == 0)
	512	{
	513	/* Make sure we have a zero-sized array. */
827aef63	514	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
f955bfc4	515	return;
	516	}
	517	else
af1e9051	518	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
4292b27d	519	}
	520	else
	521	{
f955bfc4	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
c7fb575f	528	if (unlikely (compile_options.bounds_check))
8dec97a0	529	{
f955bfc4	530	for (n=0; n < rank; n++)
	531	{
	532	index_type ret_extent;
4292b27d	533
827aef63	534	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
f955bfc4	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	}
8dec97a0	541	}
8dec97a0	542	}
4292b27d	543
f955bfc4	544	for (n = 0; n < rank; n++)
	545	{
	546	count[n] = 0;
827aef63	547	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
f955bfc4	548	}
f955bfc4	549
553877d9	550	dest = retarray->base_addr;
f955bfc4	551
	552	while(1)
	553	{
	554	*dest = GFC_INTEGER_8_HUGE;
	555	count[0]++;
	556	dest += dstride[0];
	557	n = 0;
	558	while (count[n] == extent[n])
7ebee933	559	{
f955bfc4	560	/* When we get to the end of a dimension, reset it and increment
7ebee933	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++;
bacde0a1	567	if (n >= rank)
f955bfc4	568	return;
7ebee933	569	else
	570	{
	571	count[n]++;
	572	dest += dstride[n];
	573	}
f955bfc4	574	}
f955bfc4	575	}
4292b27d	576	}
4292b27d	577
920e54ef	578	#endif