[gcc.git] / libgfortran / generated / minloc0_16_i16.c

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

This file is part of the GNU Fortran 95 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"
#include <assert.h>


#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)


extern void minloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array, GFC_LOGICAL_4);
export_proto(minloc0_16_i16);

void
minloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array, GFC_LOGICAL_4 back)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  const GFC_INTEGER_16 *base;
  GFC_INTEGER_16 * restrict dest;
  index_type rank;
  index_type n;

  assert(back == 0);
  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->offset = 0;
      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
				"MINLOC");
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->base_addr;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->base_addr;

  /* Initialize the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 1;
  {

    GFC_INTEGER_16 minval;
#if defined(GFC_INTEGER_16_QUIET_NAN)
    int fast = 0;
#endif

#if defined(GFC_INTEGER_16_INFINITY)
    minval = GFC_INTEGER_16_INFINITY;
#else
    minval = GFC_INTEGER_16_HUGE;
#endif
  while (base)
    {
      do
	{
	  /* Implementation start.  */

#if defined(GFC_INTEGER_16_QUIET_NAN)
	}
      while (0);
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*base <= minval)
		{
		  fast = 1;
		  minval = *base;
		  for (n = 0; n < rank; n++)
		    dest[n * dstride] = count[n] + 1;
		  break;
		}
	      base += sstride[0];
	    }
	  while (++count[0] != extent[0]);
	  if (likely (fast))
	    continue;
	}
      else do
	{
#endif
	  if (*base < minval)
	    {
	      minval = *base;
	      for (n = 0; n < rank; n++)
		dest[n * dstride] = count[n] + 1;
	    }
	  /* Implementation end.  */
	  /* Advance to the next element.  */
	  base += sstride[0];
	}
      while (++count[0] != extent[0]);
      n = 0;
      do
	{
	  /* 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];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      base = NULL;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	    }
	}
      while (count[n] == extent[n]);
    }
  }
}


extern void mminloc0_16_i16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, gfc_array_l1 * const restrict,
	GFC_LOGICAL_4);
export_proto(mminloc0_16_i16);

void
mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array,
	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  GFC_INTEGER_16 *dest;
  const GFC_INTEGER_16 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;

  assert(back == 0);
  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->offset = 0;
      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{

	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
				  "MINLOC");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
				  "MASK argument", "MINLOC");
	}
    }

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  mbase = mask->base_addr;

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

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->base_addr;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->base_addr;

  /* Initialize the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;
  {

  GFC_INTEGER_16 minval;
   int fast = 0;

#if defined(GFC_INTEGER_16_INFINITY)
    minval = GFC_INTEGER_16_INFINITY;
#else
    minval = GFC_INTEGER_16_HUGE;
#endif
  while (base)
    {
      do
	{
	  /* Implementation start.  */

	}
      while (0);
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_INTEGER_16_QUIET_NAN)
		  if (unlikely (dest[0] == 0))
		    for (n = 0; n < rank; n++)
		      dest[n * dstride] = count[n] + 1;
		  if (*base <= minval)
#endif
		    {
		      fast = 1;
		      minval = *base;
		      for (n = 0; n < rank; n++)
			dest[n * dstride] = count[n] + 1;
		      break;
		    }
		}
	      base += sstride[0];
	      mbase += mstride[0];
	    }
	  while (++count[0] != extent[0]);
	  if (likely (fast))
	    continue;
	}
      else do
	{
	  if (*mbase && *base < minval)
	    {
	      minval = *base;
	      for (n = 0; n < rank; n++)
		dest[n * dstride] = count[n] + 1;
	    }
	  /* Implementation end.  */
	  /* Advance to the next element.  */
	  base += sstride[0];
	  mbase += mstride[0];
	}
      while (++count[0] != extent[0]);
      n = 0;
      do
	{
	  /* 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];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      base = NULL;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      mbase += mstride[n];
	    }
	}
      while (count[n] == extent[n]);
    }
  }
}


extern void sminloc0_16_i16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
export_proto(sminloc0_16_i16);

void
sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array,
	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_16 *dest;

  if (*mask)
    {
      minloc0_16_i16 (retarray, array, back);
      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->offset = 0;
      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
    }
  else if (unlikely (compile_options.bounds_check))
    {
       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
			       "MINLOC");
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->base_addr;
  for (n = 0; n<rank; n++)
    dest[n * dstride] = 0 ;
}
#endif
Commit	Line	Data
	1	/* Implementation of the MINLOC intrinsic
	2	Copyright (C) 2002-2018 Free Software Foundation, Inc.
	3	Contributed by Paul Brook <paul@nowt.org>
	4
	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU General Public
	9	License as published by the Free Software Foundation; either
	10	version 3 of the License, or (at your option) any later version.
	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
	15	GNU General Public License for more details.
	16
	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/>. */
	25
	26	#include "libgfortran.h"
	27	#include <assert.h>
	28
	29
	30	#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
	31
	32
	33	extern void minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
	34	gfc_array_i16 * const restrict array, GFC_LOGICAL_4);
	35	export_proto(minloc0_16_i16);
	36
	37	void
	38	minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
	39	gfc_array_i16 * const restrict array, GFC_LOGICAL_4 back)
	40	{
	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;
	45	const GFC_INTEGER_16 *base;
	46	GFC_INTEGER_16 * restrict dest;
	47	index_type rank;
	48	index_type n;
	49
	50	assert(back == 0);
	51	rank = GFC_DESCRIPTOR_RANK (array);
	52	if (rank <= 0)
	53	runtime_error ("Rank of array needs to be > 0");
	54
	55	if (retarray->base_addr == NULL)
	56	{
	57	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	58	GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
	59	retarray->offset = 0;
	60	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
	61	}
	62	else
	63	{
	64	if (unlikely (compile_options.bounds_check))
	65	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	66	"MINLOC");
	67	}
	68
	69	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	70	dest = retarray->base_addr;
	71	for (n = 0; n < rank; n++)
	72	{
	73	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	74	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
	75	count[n] = 0;
	76	if (extent[n] <= 0)
	77	{
	78	/* Set the return value. */
	79	for (n = 0; n < rank; n++)
	80	dest[n * dstride] = 0;
	81	return;
	82	}
	83	}
	84
	85	base = array->base_addr;
	86
	87	/* Initialize the return value. */
	88	for (n = 0; n < rank; n++)
	89	dest[n * dstride] = 1;
	90	{
	91
	92	GFC_INTEGER_16 minval;
	93	#if defined(GFC_INTEGER_16_QUIET_NAN)
	94	int fast = 0;
	95	#endif
	96
	97	#if defined(GFC_INTEGER_16_INFINITY)
	98	minval = GFC_INTEGER_16_INFINITY;
	99	#else
	100	minval = GFC_INTEGER_16_HUGE;
	101	#endif
	102	while (base)
	103	{
	104	do
	105	{
	106	/* Implementation start. */
	107
	108	#if defined(GFC_INTEGER_16_QUIET_NAN)
	109	}
	110	while (0);
	111	if (unlikely (!fast))
	112	{
	113	do
	114	{
	115	if (*base <= minval)
	116	{
	117	fast = 1;
	118	minval = *base;
	119	for (n = 0; n < rank; n++)
	120	dest[n * dstride] = count[n] + 1;
	121	break;
	122	}
	123	base += sstride[0];
	124	}
	125	while (++count[0] != extent[0]);
	126	if (likely (fast))
	127	continue;
	128	}
	129	else do
	130	{
	131	#endif
	132	if (*base < minval)
	133	{
	134	minval = *base;
	135	for (n = 0; n < rank; n++)
	136	dest[n * dstride] = count[n] + 1;
	137	}
	138	/* Implementation end. */
	139	/* Advance to the next element. */
	140	base += sstride[0];
	141	}
	142	while (++count[0] != extent[0]);
	143	n = 0;
	144	do
	145	{
	146	/* When we get to the end of a dimension, reset it and increment
	147	the next dimension. */
	148	count[n] = 0;
	149	/* We could precalculate these products, but this is a less
	150	frequently used path so probably not worth it. */
	151	base -= sstride[n] * extent[n];
	152	n++;
	153	if (n >= rank)
	154	{
	155	/* Break out of the loop. */
	156	base = NULL;
	157	break;
	158	}
	159	else
	160	{
	161	count[n]++;
	162	base += sstride[n];
	163	}
	164	}
	165	while (count[n] == extent[n]);
	166	}
	167	}
	168	}
	169
	170
	171	extern void mminloc0_16_i16 (gfc_array_i16 * const restrict,
	172	gfc_array_i16 * const restrict, gfc_array_l1 * const restrict,
	173	GFC_LOGICAL_4);
	174	export_proto(mminloc0_16_i16);
	175
	176	void
	177	mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
	178	gfc_array_i16 * const restrict array,
	179	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
	180	{
	181	index_type count[GFC_MAX_DIMENSIONS];
	182	index_type extent[GFC_MAX_DIMENSIONS];
	183	index_type sstride[GFC_MAX_DIMENSIONS];
	184	index_type mstride[GFC_MAX_DIMENSIONS];
	185	index_type dstride;
	186	GFC_INTEGER_16 *dest;
	187	const GFC_INTEGER_16 *base;
	188	GFC_LOGICAL_1 *mbase;
	189	int rank;
	190	index_type n;
	191	int mask_kind;
	192
	193	assert(back == 0);
	194	rank = GFC_DESCRIPTOR_RANK (array);
	195	if (rank <= 0)
	196	runtime_error ("Rank of array needs to be > 0");
	197
	198	if (retarray->base_addr == NULL)
	199	{
	200	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
	201	GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
	202	retarray->offset = 0;
	203	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
	204	}
	205	else
	206	{
	207	if (unlikely (compile_options.bounds_check))
	208	{
	209
	210	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	211	"MINLOC");
	212	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	213	"MASK argument", "MINLOC");
	214	}
	215	}
	216
	217	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	218
	219	mbase = mask->base_addr;
	220
	221	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	222	#ifdef HAVE_GFC_LOGICAL_16
	223	\|\| mask_kind == 16
	224	#endif
	225	)
	226	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	227	else
	228	runtime_error ("Funny sized logical array");
	229
	230	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	231	dest = retarray->base_addr;
	232	for (n = 0; n < rank; n++)
	233	{
	234	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	235	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	236	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
	237	count[n] = 0;
	238	if (extent[n] <= 0)
	239	{
	240	/* Set the return value. */
	241	for (n = 0; n < rank; n++)
	242	dest[n * dstride] = 0;
	243	return;
	244	}
	245	}
	246
	247	base = array->base_addr;
	248
	249	/* Initialize the return value. */
	250	for (n = 0; n < rank; n++)
	251	dest[n * dstride] = 0;
	252	{
	253
	254	GFC_INTEGER_16 minval;
	255	int fast = 0;
	256
	257	#if defined(GFC_INTEGER_16_INFINITY)
	258	minval = GFC_INTEGER_16_INFINITY;
	259	#else
	260	minval = GFC_INTEGER_16_HUGE;
	261	#endif
	262	while (base)
	263	{
	264	do
	265	{
	266	/* Implementation start. */
	267
	268	}
	269	while (0);
	270	if (unlikely (!fast))
	271	{
	272	do
	273	{
	274	if (*mbase)
	275	{
	276	#if defined(GFC_INTEGER_16_QUIET_NAN)
	277	if (unlikely (dest[0] == 0))
	278	for (n = 0; n < rank; n++)
	279	dest[n * dstride] = count[n] + 1;
	280	if (*base <= minval)
	281	#endif
	282	{
	283	fast = 1;
	284	minval = *base;
	285	for (n = 0; n < rank; n++)
	286	dest[n * dstride] = count[n] + 1;
	287	break;
	288	}
	289	}
	290	base += sstride[0];
	291	mbase += mstride[0];
	292	}
	293	while (++count[0] != extent[0]);
	294	if (likely (fast))
	295	continue;
	296	}
	297	else do
	298	{
	299	if (mbase && base < minval)
	300	{
	301	minval = *base;
	302	for (n = 0; n < rank; n++)
	303	dest[n * dstride] = count[n] + 1;
	304	}
	305	/* Implementation end. */
	306	/* Advance to the next element. */
	307	base += sstride[0];
	308	mbase += mstride[0];
	309	}
	310	while (++count[0] != extent[0]);
	311	n = 0;
	312	do
	313	{
	314	/* When we get to the end of a dimension, reset it and increment
	315	the next dimension. */
	316	count[n] = 0;
	317	/* We could precalculate these products, but this is a less
	318	frequently used path so probably not worth it. */
	319	base -= sstride[n] * extent[n];
	320	mbase -= mstride[n] * extent[n];
	321	n++;
	322	if (n >= rank)
	323	{
	324	/* Break out of the loop. */
	325	base = NULL;
	326	break;
	327	}
	328	else
	329	{
	330	count[n]++;
	331	base += sstride[n];
	332	mbase += mstride[n];
	333	}
	334	}
	335	while (count[n] == extent[n]);
	336	}
	337	}
	338	}
	339
	340
	341	extern void sminloc0_16_i16 (gfc_array_i16 * const restrict,
	342	gfc_array_i16 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
	343	export_proto(sminloc0_16_i16);
	344
	345	void
	346	sminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
	347	gfc_array_i16 * const restrict array,
	348	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
	349	{
	350	index_type rank;
	351	index_type dstride;
	352	index_type n;
	353	GFC_INTEGER_16 *dest;
	354
	355	if (*mask)
	356	{
	357	minloc0_16_i16 (retarray, array, back);
	358	return;
	359	}
	360
	361	rank = GFC_DESCRIPTOR_RANK (array);
	362
	363	if (rank <= 0)
	364	runtime_error ("Rank of array needs to be > 0");
	365
	366	if (retarray->base_addr == NULL)
	367	{
	368	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	369	GFC_DTYPE_COPY_SETRANK(retarray,retarray,1);
	370	retarray->offset = 0;
	371	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
	372	}
	373	else if (unlikely (compile_options.bounds_check))
	374	{
	375	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	376	"MINLOC");
	377	}
	378
	379	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	380	dest = retarray->base_addr;
	381	for (n = 0; n<rank; n++)
	382	dest[n * dstride] = 0 ;
	383	}
	384	#endif