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

/* Implementation of the MAXVAL 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 "libgfortran.h"


extern void maxval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(maxval_i4);

void
maxval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *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];
  GFC_INTEGER_4 *base;
  GFC_INTEGER_4 *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;

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

  if (array->dim[0].stride == 0)
    array->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_4)
		 		 * retarray->dim[rank-1].stride
				 * extent[rank-1]);
      retarray->base = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
    }
  else
    {
      if (retarray->dim[0].stride == 0)
	retarray->dim[0].stride = 1;

      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect");
    }

  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_4 result;
      src = base;
      {

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

  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 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 mmaxval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *,
					       gfc_array_l4 *);
export_proto(mmaxval_i4);

void
mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
				  index_type *pdim, gfc_array_l4 * 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 *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;

  /* 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;

  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;
    }

  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_4)
		 		 * retarray->dim[rank-1].stride
				 * extent[rank-1]);
      retarray->base = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
    }
  else
    {
      if (retarray->dim[0].stride == 0)
	retarray->dim[0].stride = 1;

      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect");
    }

  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_4 result;
      src = base;
      msrc = mbase;
      {

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

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