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

/* Implementation of the MINLOC intrinsic
   Copyright 2002 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 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

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.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */

#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <float.h>
#include <limits.h>
#include "libgfortran.h"


#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)


extern void minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array);
export_proto(minloc0_8_i8);

void
minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  GFC_INTEGER_8 *base;
  GFC_INTEGER_8 *dest;
  index_type rank;
  index_type n;

  rank = GFC_DESCRIPTOR_RANK (array);
  if (rank <= 0)
    runtime_error ("Rank of array needs to be > 0");

  if (retarray->data == NULL)
    {
      retarray->dim[0].lbound = 0;
      retarray->dim[0].ubound = rank-1;
      retarray->dim[0].stride = 1;
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
    }
  else
    {
      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	runtime_error ("rank of return array does not equal 1");

      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
        runtime_error ("dimension of return array incorrect");

      if (retarray->dim[0].stride == 0)
	retarray->dim[0].stride = 1;
    }

  /* TODO:  It should be a front end job to correctly set the strides.  */

  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;

  dstride = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = array->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->data;

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

  GFC_INTEGER_8 minval;

  minval = GFC_INTEGER_8_HUGE;

  while (base)
    {
      {
        /* Implementation start.  */

  if (*base < minval)
    {
      minval = *base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }
        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[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 proabably 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];
            }
        }
    }
  }
}


extern void mminloc0_8_i8 (gfc_array_i8 *, gfc_array_i8 *, gfc_array_l4 *);
export_proto(mminloc0_8_i8);

void
mminloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array,
				  gfc_array_l4 * mask)
{
  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_8 *dest;
  GFC_INTEGER_8 *base;
  GFC_LOGICAL_4 *mbase;
  int rank;
  index_type n;

  rank = GFC_DESCRIPTOR_RANK (array);
  if (rank <= 0)
    runtime_error ("Rank of array needs to be > 0");

  if (retarray->data == NULL)
    {
      retarray->dim[0].lbound = 0;
      retarray->dim[0].ubound = rank-1;
      retarray->dim[0].stride = 1;
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
    }
  else
    {
      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	runtime_error ("rank of return array does not equal 1");

      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
        runtime_error ("dimension of return array incorrect");

      if (retarray->dim[0].stride == 0)
	retarray->dim[0].stride = 1;
    }

  /* TODO:  It should be a front end job to correctly set the strides.  */

  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;

  if (mask->dim[0].stride == 0)
    mask->dim[0].stride = 1;

  dstride = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = array->dim[n].stride;
      mstride[n] = mask->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->data;
  mbase = mask->data;

  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
    {
      /* This allows the same loop to be used for all logical types.  */
      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
      for (n = 0; n < rank; n++)
        mstride[n] <<= 1;
      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
    }


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

  GFC_INTEGER_8 minval;

  minval = GFC_INTEGER_8_HUGE;

  while (base)
    {
      {
        /* Implementation start.  */

  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.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[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 proabably 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];
            }
        }
    }
  }
}

#endif
Commit	Line	Data
6de9cd9a DN	1	/* Implementation of the MINLOC intrinsic
	2	Copyright 2002 Free Software Foundation, Inc.
	3	Contributed by Paul Brook <paul@nowt.org>
	4
57dea9f6	5	This file is part of the GNU Fortran 95 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
57dea9f6 TM	10	version 2 of the License, or (at your option) any later version.
	11
	12	In addition to the permissions in the GNU General Public License, the
	13	Free Software Foundation gives you unlimited permission to link the
	14	compiled version of this file into combinations with other programs,
	15	and to distribute those combinations without any restriction coming
	16	from the use of this file. (The General Public License restrictions
	17	do apply in other respects; for example, they cover modification of
	18	the file, and distribution when not linked into a combine
	19	executable.)
6de9cd9a DN	20
	21	Libgfortran is distributed in the hope that it will be useful,
	22	but WITHOUT ANY WARRANTY; without even the implied warranty of
	23	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6	24	GNU General Public License for more details.
6de9cd9a	25
57dea9f6 TM	26	You should have received a copy of the GNU General Public
57dea9f6 TM	27	License along with libgfortran; see the file COPYING. If not,
fe2ae685 KC	28	write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
fe2ae685 KC	29	Boston, MA 02110-1301, USA. */
6de9cd9a DN	30
	31	#include "config.h"
	32	#include <stdlib.h>
	33	#include <assert.h>
	34	#include <float.h>
	35	#include <limits.h>
	36	#include "libgfortran.h"
	37
	38
644cb69f FXC	39	#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
644cb69f FXC	40
7d7b8bfe	41
7f68c75f RH	42	extern void minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array);
7f68c75f RH	43	export_proto(minloc0_8_i8);
7d7b8bfe	44
6de9cd9a	45	void
7f68c75f	46	minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array)
6de9cd9a DN	47	{
	48	index_type count[GFC_MAX_DIMENSIONS];
	49	index_type extent[GFC_MAX_DIMENSIONS];
	50	index_type sstride[GFC_MAX_DIMENSIONS];
	51	index_type dstride;
	52	GFC_INTEGER_8 *base;
	53	GFC_INTEGER_8 *dest;
	54	index_type rank;
	55	index_type n;
	56
	57	rank = GFC_DESCRIPTOR_RANK (array);
50dd63a9 TK	58	if (rank <= 0)
	59	runtime_error ("Rank of array needs to be > 0");
	60
	61	if (retarray->data == NULL)
	62	{
	63	retarray->dim[0].lbound = 0;
	64	retarray->dim[0].ubound = rank-1;
	65	retarray->dim[0].stride = 1;
	66	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
efd4dc1a	67	retarray->offset = 0;
50dd63a9 TK	68	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
	69	}
	70	else
	71	{
	72	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	73	runtime_error ("rank of return array does not equal 1");
	74
	75	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	76	runtime_error ("dimension of return array incorrect");
	77
	78	if (retarray->dim[0].stride == 0)
	79	retarray->dim[0].stride = 1;
	80	}
e33e218b TK	81
	82	/* TODO: It should be a front end job to correctly set the strides. */
	83
6de9cd9a DN	84	if (array->dim[0].stride == 0)
6de9cd9a DN	85	array->dim[0].stride = 1;
6de9cd9a DN	86
	87	dstride = retarray->dim[0].stride;
	88	dest = retarray->data;
	89	for (n = 0; n < rank; n++)
	90	{
	91	sstride[n] = array->dim[n].stride;
	92	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	93	count[n] = 0;
	94	if (extent[n] <= 0)
	95	{
	96	/* Set the return value. */
	97	for (n = 0; n < rank; n++)
	98	dest[n * dstride] = 0;
	99	return;
	100	}
	101	}
	102
	103	base = array->data;
	104
	105	/* Initialize the return value. */
	106	for (n = 0; n < rank; n++)
	107	dest[n * dstride] = 1;
	108	{
	109
	110	GFC_INTEGER_8 minval;
	111
	112	minval = GFC_INTEGER_8_HUGE;
	113
	114	while (base)
	115	{
	116	{
	117	/* Implementation start. */
	118
	119	if (*base < minval)
	120	{
	121	minval = *base;
	122	for (n = 0; n < rank; n++)
	123	dest[n * dstride] = count[n] + 1;
	124	}
	125	/* Implementation end. */
	126	}
	127	/* Advance to the next element. */
	128	count[0]++;
	129	base += sstride[0];
	130	n = 0;
	131	while (count[n] == extent[n])
	132	{
	133	/* When we get to the end of a dimension, reset it and increment
	134	the next dimension. */
	135	count[n] = 0;
	136	/* We could precalculate these products, but this is a less
	137	frequently used path so proabably not worth it. */
	138	base -= sstride[n] * extent[n];
	139	n++;
	140	if (n == rank)
	141	{
	142	/* Break out of the loop. */
	143	base = NULL;
	144	break;
	145	}
	146	else
	147	{
	148	count[n]++;
	149	base += sstride[n];
150	}
151	}
152	}
153	}
154	}
155
7d7b8bfe	156
7f68c75f RH	157	extern void mminloc0_8_i8 (gfc_array_i8 , gfc_array_i8 , gfc_array_l4 *);
7f68c75f RH	158	export_proto(mminloc0_8_i8);
7d7b8bfe	159
6de9cd9a	160	void
7f68c75f RH	161	mminloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array,
7f68c75f RH	162	gfc_array_l4 * mask)
6de9cd9a DN	163	{
	164	index_type count[GFC_MAX_DIMENSIONS];
	165	index_type extent[GFC_MAX_DIMENSIONS];
	166	index_type sstride[GFC_MAX_DIMENSIONS];
	167	index_type mstride[GFC_MAX_DIMENSIONS];
	168	index_type dstride;
	169	GFC_INTEGER_8 *dest;
	170	GFC_INTEGER_8 *base;
	171	GFC_LOGICAL_4 *mbase;
	172	int rank;
	173	index_type n;
	174
	175	rank = GFC_DESCRIPTOR_RANK (array);
50dd63a9 TK	176	if (rank <= 0)
	177	runtime_error ("Rank of array needs to be > 0");
	178
	179	if (retarray->data == NULL)
	180	{
	181	retarray->dim[0].lbound = 0;
	182	retarray->dim[0].ubound = rank-1;
	183	retarray->dim[0].stride = 1;
	184	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
efd4dc1a	185	retarray->offset = 0;
50dd63a9 TK	186	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
	187	}
	188	else
	189	{
	190	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	191	runtime_error ("rank of return array does not equal 1");
	192
	193	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	194	runtime_error ("dimension of return array incorrect");
	195
	196	if (retarray->dim[0].stride == 0)
	197	retarray->dim[0].stride = 1;
	198	}
6de9cd9a	199
e33e218b TK	200	/* TODO: It should be a front end job to correctly set the strides. */
e33e218b TK	201
6de9cd9a DN	202	if (array->dim[0].stride == 0)
6de9cd9a DN	203	array->dim[0].stride = 1;
6de9cd9a	204
c6abe94d TK	205	if (mask->dim[0].stride == 0)
	206	mask->dim[0].stride = 1;
	207
6de9cd9a DN	208	dstride = retarray->dim[0].stride;
	209	dest = retarray->data;
	210	for (n = 0; n < rank; n++)
	211	{
	212	sstride[n] = array->dim[n].stride;
	213	mstride[n] = mask->dim[n].stride;
	214	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	215	count[n] = 0;
	216	if (extent[n] <= 0)
	217	{
	218	/* Set the return value. */
	219	for (n = 0; n < rank; n++)
	220	dest[n * dstride] = 0;
	221	return;
	222	}
	223	}
	224
	225	base = array->data;
	226	mbase = mask->data;
	227
	228	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	229	{
	230	/* This allows the same loop to be used for all logical types. */
	231	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	232	for (n = 0; n < rank; n++)
	233	mstride[n] <<= 1;
	234	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
	235	}
	236
	237
	238	/* Initialize the return value. */
	239	for (n = 0; n < rank; n++)
	240	dest[n * dstride] = 1;
	241	{
	242
	243	GFC_INTEGER_8 minval;
	244
	245	minval = GFC_INTEGER_8_HUGE;
	246
	247	while (base)
	248	{
	249	{
	250	/* Implementation start. */
	251
	252	if (mbase && base < minval)
	253	{
	254	minval = *base;
	255	for (n = 0; n < rank; n++)
	256	dest[n * dstride] = count[n] + 1;
	257	}
	258	/* Implementation end. */
	259	}
	260	/* Advance to the next element. */
	261	count[0]++;
	262	base += sstride[0];
	263	mbase += mstride[0];
	264	n = 0;
	265	while (count[n] == extent[n])
	266	{
	267	/* When we get to the end of a dimension, reset it and increment
	268	the next dimension. */
	269	count[n] = 0;
	270	/* We could precalculate these products, but this is a less
	271	frequently used path so proabably not worth it. */
272	base -= sstride[n] * extent[n];
273	mbase -= mstride[n] * extent[n];
274	n++;
275	if (n == rank)
276	{
277	/* Break out of the loop. */
278	base = NULL;
279	break;
280	}
281	else
282	{
283	count[n]++;
284	base += sstride[n];
285	mbase += mstride[n];
286	}
287	}
288	}
289	}
290	}
644cb69f FXC	291
644cb69f FXC	292	#endif