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

/* Implementation of the MAXLOC 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., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

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


extern void maxloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *);
export_proto(maxloc1_8_i4);

void
maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim)
{
  index_type count[GFC_MAX_DIMENSIONS - 1];
  index_type extent[GFC_MAX_DIMENSIONS - 1];
  index_type sstride[GFC_MAX_DIMENSIONS - 1];
  index_type dstride[GFC_MAX_DIMENSIONS - 1];
  GFC_INTEGER_4 *base;
  GFC_INTEGER_8 *dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;

  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 1;

  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  delta = array->dim[dim].stride;

  for (n = 0; n < dim; n++)
    {
      sstride[n] = array->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = array->dim[n + 1].stride;
      extent[n] =
        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
    }

  if (retarray->data == NULL)
    {
      for (n = 0; n < rank; n++)
        {
          retarray->dim[n].lbound = 0;
          retarray->dim[n].ubound = extent[n]-1;
          if (n == 0)
            retarray->dim[n].stride = 1;
          else
            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
        }

      retarray->data
	 = internal_malloc_size (sizeof (GFC_INTEGER_8)
		 		 * retarray->dim[rank-1].stride
				 * extent[rank-1]);
      retarray->base = 0;
    }
          
  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = retarray->dim[n].stride;
      if (extent[n] <= 0)
        len = 0;
    }

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

  while (base)
    {
      GFC_INTEGER_4 *src;
      GFC_INTEGER_8 result;
      src = base;
      {

  GFC_INTEGER_4 maxval;
  maxval = -GFC_INTEGER_4_HUGE;
  result = 1;
        if (len <= 0)
	  *dest = 0;
	else
	  {
	    for (n = 0; n < len; n++, src += delta)
	      {

  if (*src > maxval)
    {
      maxval = *src;
      result = (GFC_INTEGER_8)n + 1;
    }
          }
	    *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 proabably not worth it.  */
          base -= sstride[n] * extent[n];
          dest -= dstride[n] * extent[n];
          n++;
          if (n == rank)
            {
              /* Break out of the look.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              dest += dstride[n];
            }
        }
    }
}


extern void mmaxloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *,
					       gfc_array_l4 *);
export_proto(mmaxloc1_8_i4);

void
mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
				  index_type *pdim, gfc_array_l4 * mask)
{
  index_type count[GFC_MAX_DIMENSIONS - 1];
  index_type extent[GFC_MAX_DIMENSIONS - 1];
  index_type sstride[GFC_MAX_DIMENSIONS - 1];
  index_type dstride[GFC_MAX_DIMENSIONS - 1];
  index_type mstride[GFC_MAX_DIMENSIONS - 1];
  GFC_INTEGER_8 *dest;
  GFC_INTEGER_4 *base;
  GFC_LOGICAL_4 *mbase;
  int rank;
  int dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;

  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 1;

  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  if (len <= 0)
    return;
  delta = array->dim[dim].stride;
  mdelta = mask->dim[dim].stride;

  for (n = 0; n < dim; n++)
    {
      sstride[n] = array->dim[n].stride;
      mstride[n] = mask->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = array->dim[n + 1].stride;
      mstride[n] = mask->dim[n + 1].stride;
      extent[n] =
        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = retarray->dim[n].stride;
      if (extent[n] <= 0)
        return;
    }

  dest = retarray->data;
  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;
      mdelta <<= 1;
      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
    }

  while (base)
    {
      GFC_INTEGER_4 *src;
      GFC_LOGICAL_4 *msrc;
      GFC_INTEGER_8 result;
      src = base;
      msrc = mbase;
      {

  GFC_INTEGER_4 maxval;
  maxval = -GFC_INTEGER_4_HUGE;
  result = 1;
        if (len <= 0)
	  *dest = 0;
	else
	  {
	    for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	      {

  if (*msrc && *src > maxval)
    {
      maxval = *src;
      result = (GFC_INTEGER_8)n + 1;
    }
              }
	    *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 proabably 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 look.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              mbase += mstride[n];
              dest += dstride[n];
            }
        }
    }
}
Commit	Line	Data
6de9cd9a DN	1	/* Implementation of the MAXLOC 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,
6de9cd9a DN	28	write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	29	Boston, MA 02111-1307, USA. */
	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
7d7b8bfe	38
7f68c75f RH	39	extern void maxloc1_8_i4 (gfc_array_i8 , gfc_array_i4 , index_type *);
7f68c75f RH	40	export_proto(maxloc1_8_i4);
7d7b8bfe	41
6de9cd9a	42	void
7f68c75f	43	maxloc1_8_i4 (gfc_array_i8 retarray, gfc_array_i4 array, index_type *pdim)
6de9cd9a DN	44	{
	45	index_type count[GFC_MAX_DIMENSIONS - 1];
	46	index_type extent[GFC_MAX_DIMENSIONS - 1];
	47	index_type sstride[GFC_MAX_DIMENSIONS - 1];
	48	index_type dstride[GFC_MAX_DIMENSIONS - 1];
	49	GFC_INTEGER_4 *base;
	50	GFC_INTEGER_8 *dest;
	51	index_type rank;
	52	index_type n;
	53	index_type len;
	54	index_type delta;
	55	index_type dim;
	56
	57	/* Make dim zero based to avoid confusion. */
	58	dim = (*pdim) - 1;
	59	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	60	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
	61	if (array->dim[0].stride == 0)
	62	array->dim[0].stride = 1;
	63	if (retarray->dim[0].stride == 0)
	64	retarray->dim[0].stride = 1;
	65
	66	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	67	delta = array->dim[dim].stride;
	68
	69	for (n = 0; n < dim; n++)
	70	{
	71	sstride[n] = array->dim[n].stride;
	72	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	73	}
	74	for (n = dim; n < rank; n++)
	75	{
	76	sstride[n] = array->dim[n + 1].stride;
	77	extent[n] =
	78	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	79	}
	80
6c167c45 VL	81	if (retarray->data == NULL)
	82	{
	83	for (n = 0; n < rank; n++)
	84	{
	85	retarray->dim[n].lbound = 0;
	86	retarray->dim[n].ubound = extent[n]-1;
	87	if (n == 0)
	88	retarray->dim[n].stride = 1;
	89	else
	90	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	91	}
	92
07d3cebe RH	93	retarray->data
	94	= internal_malloc_size (sizeof (GFC_INTEGER_8)
	95	* retarray->dim[rank-1].stride
	96	* extent[rank-1]);
6c167c45 VL	97	retarray->base = 0;
	98	}
	99
6de9cd9a DN	100	for (n = 0; n < rank; n++)
	101	{
	102	count[n] = 0;
	103	dstride[n] = retarray->dim[n].stride;
	104	if (extent[n] <= 0)
	105	len = 0;
	106	}
	107
	108	base = array->data;
	109	dest = retarray->data;
	110
	111	while (base)
	112	{
	113	GFC_INTEGER_4 *src;
	114	GFC_INTEGER_8 result;
	115	src = base;
	116	{
	117
	118	GFC_INTEGER_4 maxval;
	119	maxval = -GFC_INTEGER_4_HUGE;
	120	result = 1;
	121	if (len <= 0)
	122	*dest = 0;
	123	else
	124	{
	125	for (n = 0; n < len; n++, src += delta)
	126	{
	127
	128	if (*src > maxval)
	129	{
	130	maxval = *src;
	131	result = (GFC_INTEGER_8)n + 1;
	132	}
	133	}
	134	*dest = result;
	135	}
	136	}
	137	/* Advance to the next element. */
	138	count[0]++;
	139	base += sstride[0];
	140	dest += dstride[0];
	141	n = 0;
	142	while (count[n] == extent[n])
	143	{
	144	/* When we get to the end of a dimension, reset it and increment
	145	the next dimension. */
	146	count[n] = 0;
	147	/* We could precalculate these products, but this is a less
	148	frequently used path so proabably not worth it. */
	149	base -= sstride[n] * extent[n];
	150	dest -= dstride[n] * extent[n];
	151	n++;
	152	if (n == rank)
	153	{
	154	/* Break out of the look. */
	155	base = NULL;
	156	break;
	157	}
	158	else
	159	{
	160	count[n]++;
	161	base += sstride[n];
	162	dest += dstride[n];
	163	}
164	}
165	}
166	}
167
7d7b8bfe	168
7f68c75f RH	169	extern void mmaxloc1_8_i4 (gfc_array_i8 , gfc_array_i4 , index_type *,
	170	gfc_array_l4 *);
	171	export_proto(mmaxloc1_8_i4);
7d7b8bfe	172
6de9cd9a	173	void
7f68c75f RH	174	mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
7f68c75f RH	175	index_type pdim, gfc_array_l4 mask)
6de9cd9a DN	176	{
	177	index_type count[GFC_MAX_DIMENSIONS - 1];
	178	index_type extent[GFC_MAX_DIMENSIONS - 1];
	179	index_type sstride[GFC_MAX_DIMENSIONS - 1];
	180	index_type dstride[GFC_MAX_DIMENSIONS - 1];
	181	index_type mstride[GFC_MAX_DIMENSIONS - 1];
	182	GFC_INTEGER_8 *dest;
	183	GFC_INTEGER_4 *base;
	184	GFC_LOGICAL_4 *mbase;
	185	int rank;
	186	int dim;
	187	index_type n;
	188	index_type len;
	189	index_type delta;
	190	index_type mdelta;
	191
	192	dim = (*pdim) - 1;
	193	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	194	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
	195	if (array->dim[0].stride == 0)
	196	array->dim[0].stride = 1;
	197	if (retarray->dim[0].stride == 0)
	198	retarray->dim[0].stride = 1;
	199
	200	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	201	if (len <= 0)
	202	return;
	203	delta = array->dim[dim].stride;
	204	mdelta = mask->dim[dim].stride;
	205
	206	for (n = 0; n < dim; n++)
	207	{
	208	sstride[n] = array->dim[n].stride;
	209	mstride[n] = mask->dim[n].stride;
	210	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	211	}
	212	for (n = dim; n < rank; n++)
	213	{
	214	sstride[n] = array->dim[n + 1].stride;
	215	mstride[n] = mask->dim[n + 1].stride;
	216	extent[n] =
	217	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	218	}
	219
	220	for (n = 0; n < rank; n++)
	221	{
	222	count[n] = 0;
	223	dstride[n] = retarray->dim[n].stride;
	224	if (extent[n] <= 0)
	225	return;
	226	}
	227
	228	dest = retarray->data;
	229	base = array->data;
	230	mbase = mask->data;
	231
	232	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	233	{
	234	/* This allows the same loop to be used for all logical types. */
	235	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	236	for (n = 0; n < rank; n++)
	237	mstride[n] <<= 1;
	238	mdelta <<= 1;
	239	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
240	}
241
242	while (base)
243	{
244	GFC_INTEGER_4 *src;
245	GFC_LOGICAL_4 *msrc;
246	GFC_INTEGER_8 result;
247	src = base;
248	msrc = mbase;
249	{
250
251	GFC_INTEGER_4 maxval;
252	maxval = -GFC_INTEGER_4_HUGE;
253	result = 1;
254	if (len <= 0)
255	*dest = 0;
256	else
257	{
258	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
259	{
260
261	if (msrc && src > maxval)
262	{
263	maxval = *src;
264	result = (GFC_INTEGER_8)n + 1;
265	}
266	}
267	*dest = result;
268	}
269	}
270	/* Advance to the next element. */
271	count[0]++;
272	base += sstride[0];
273	mbase += mstride[0];
274	dest += dstride[0];
275	n = 0;
276	while (count[n] == extent[n])
277	{
278	/* When we get to the end of a dimension, reset it and increment
279	the next dimension. */
280	count[n] = 0;
281	/* We could precalculate these products, but this is a less
282	frequently used path so proabably not worth it. */
283	base -= sstride[n] * extent[n];
284	mbase -= mstride[n] * extent[n];
285	dest -= dstride[n] * extent[n];
286	n++;
287	if (n == rank)
288	{
289	/* Break out of the look. */
290	base = NULL;
291	break;
292	}
293	else
294	{
295	count[n]++;
296	base += sstride[n];
297	mbase += mstride[n];
298	dest += dstride[n];
299	}
300	}
301	}
302	}
303