[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 (libgfor).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 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 Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with libgfor; see the file COPYING.LIB.  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_np(__maxval_i4);

void
__maxval_i4 (gfc_array_i4 *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_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;
  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_4)
		 		 * 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_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_np(__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 - 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_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;
  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_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
	5	This file is part of the GNU Fortran 95 runtime library (libgfor).
	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU Lesser General Public
	9	License as published by the Free Software Foundation; either
	10	version 2.1 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 Lesser General Public License for more details.
	16
	17	You should have received a copy of the GNU Lesser General Public
	18	License along with libgfor; see the file COPYING.LIB. If not,
	19	write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	20	Boston, MA 02111-1307, USA. */
	21
	22	#include "config.h"
	23	#include <stdlib.h>
	24	#include <assert.h>
	25	#include <float.h>
	26	#include "libgfortran.h"
	27
7d7b8bfe RH	28
	29	extern void __maxval_i4 (gfc_array_i4 , gfc_array_i4 , index_type *);
	30	export_proto_np(__maxval_i4);
	31
6de9cd9a	32	void
7d7b8bfe	33	__maxval_i4 (gfc_array_i4 retarray, gfc_array_i4 array, index_type *pdim)
6de9cd9a DN	34	{
	35	index_type count[GFC_MAX_DIMENSIONS - 1];
	36	index_type extent[GFC_MAX_DIMENSIONS - 1];
	37	index_type sstride[GFC_MAX_DIMENSIONS - 1];
	38	index_type dstride[GFC_MAX_DIMENSIONS - 1];
	39	GFC_INTEGER_4 *base;
	40	GFC_INTEGER_4 *dest;
	41	index_type rank;
	42	index_type n;
	43	index_type len;
	44	index_type delta;
	45	index_type dim;
	46
	47	/* Make dim zero based to avoid confusion. */
	48	dim = (*pdim) - 1;
	49	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	50	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
	51	if (array->dim[0].stride == 0)
	52	array->dim[0].stride = 1;
	53	if (retarray->dim[0].stride == 0)
	54	retarray->dim[0].stride = 1;
	55
	56	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	57	delta = array->dim[dim].stride;
	58
	59	for (n = 0; n < dim; n++)
	60	{
	61	sstride[n] = array->dim[n].stride;
	62	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	63	}
	64	for (n = dim; n < rank; n++)
	65	{
	66	sstride[n] = array->dim[n + 1].stride;
	67	extent[n] =
	68	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	69	}
	70
6c167c45 VL	71	if (retarray->data == NULL)
	72	{
	73	for (n = 0; n < rank; n++)
	74	{
	75	retarray->dim[n].lbound = 0;
	76	retarray->dim[n].ubound = extent[n]-1;
	77	if (n == 0)
	78	retarray->dim[n].stride = 1;
	79	else
	80	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	81	}
	82
07d3cebe RH	83	retarray->data
	84	= internal_malloc_size (sizeof (GFC_INTEGER_4)
	85	* retarray->dim[rank-1].stride
	86	* extent[rank-1]);
6c167c45 VL	87	retarray->base = 0;
	88	}
	89
6de9cd9a DN	90	for (n = 0; n < rank; n++)
	91	{
	92	count[n] = 0;
	93	dstride[n] = retarray->dim[n].stride;
	94	if (extent[n] <= 0)
	95	len = 0;
	96	}
	97
	98	base = array->data;
	99	dest = retarray->data;
	100
	101	while (base)
	102	{
	103	GFC_INTEGER_4 *src;
	104	GFC_INTEGER_4 result;
	105	src = base;
	106	{
	107
	108	result = -GFC_INTEGER_4_HUGE;
	109	if (len <= 0)
	110	*dest = -GFC_INTEGER_4_HUGE;
	111	else
	112	{
	113	for (n = 0; n < len; n++, src += delta)
	114	{
	115
	116	if (*src > result)
	117	result = *src;
	118	}
	119	*dest = result;
	120	}
	121	}
	122	/* Advance to the next element. */
	123	count[0]++;
	124	base += sstride[0];
	125	dest += dstride[0];
	126	n = 0;
	127	while (count[n] == extent[n])
	128	{
	129	/* When we get to the end of a dimension, reset it and increment
	130	the next dimension. */
	131	count[n] = 0;
	132	/* We could precalculate these products, but this is a less
	133	frequently used path so proabably not worth it. */
	134	base -= sstride[n] * extent[n];
	135	dest -= dstride[n] * extent[n];
	136	n++;
	137	if (n == rank)
	138	{
	139	/* Break out of the look. */
	140	base = NULL;
	141	break;
	142	}
	143	else
	144	{
	145	count[n]++;
	146	base += sstride[n];
	147	dest += dstride[n];
	148	}
	149	}
	150	}
	151	}
	152
7d7b8bfe RH	153
	154	extern void __mmaxval_i4 (gfc_array_i4 , gfc_array_i4 , index_type *,
	155	gfc_array_l4 *);
	156	export_proto_np(__mmaxval_i4);
	157
6de9cd9a DN	158	void
	159	__mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type pdim, gfc_array_l4 mask)
	160	{
	161	index_type count[GFC_MAX_DIMENSIONS - 1];
	162	index_type extent[GFC_MAX_DIMENSIONS - 1];
	163	index_type sstride[GFC_MAX_DIMENSIONS - 1];
	164	index_type dstride[GFC_MAX_DIMENSIONS - 1];
	165	index_type mstride[GFC_MAX_DIMENSIONS - 1];
	166	GFC_INTEGER_4 *dest;
	167	GFC_INTEGER_4 *base;
	168	GFC_LOGICAL_4 *mbase;
	169	int rank;
	170	int dim;
	171	index_type n;
	172	index_type len;
	173	index_type delta;
	174	index_type mdelta;
	175
	176	dim = (*pdim) - 1;
	177	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	178	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
	179	if (array->dim[0].stride == 0)
	180	array->dim[0].stride = 1;
	181	if (retarray->dim[0].stride == 0)
	182	retarray->dim[0].stride = 1;
	183
	184	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	185	if (len <= 0)
	186	return;
	187	delta = array->dim[dim].stride;
	188	mdelta = mask->dim[dim].stride;
	189
	190	for (n = 0; n < dim; n++)
	191	{
	192	sstride[n] = array->dim[n].stride;
	193	mstride[n] = mask->dim[n].stride;
	194	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	195	}
	196	for (n = dim; n < rank; n++)
	197	{
	198	sstride[n] = array->dim[n + 1].stride;
	199	mstride[n] = mask->dim[n + 1].stride;
	200	extent[n] =
	201	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	202	}
	203
	204	for (n = 0; n < rank; n++)
	205	{
	206	count[n] = 0;
	207	dstride[n] = retarray->dim[n].stride;
	208	if (extent[n] <= 0)
	209	return;
	210	}
	211
	212	dest = retarray->data;
	213	base = array->data;
	214	mbase = mask->data;
	215
	216	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	217	{
	218	/* This allows the same loop to be used for all logical types. */
	219	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	220	for (n = 0; n < rank; n++)
	221	mstride[n] <<= 1;
222	mdelta <<= 1;
223	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
224	}
225
226	while (base)
227	{
228	GFC_INTEGER_4 *src;
229	GFC_LOGICAL_4 *msrc;
230	GFC_INTEGER_4 result;
231	src = base;
232	msrc = mbase;
233	{
234
235	result = -GFC_INTEGER_4_HUGE;
236	if (len <= 0)
237	*dest = -GFC_INTEGER_4_HUGE;
238	else
239	{
240	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
241	{
242
243	if (msrc && src > result)
244	result = *src;
245	}
246	*dest = result;
247	}
248	}
249	/* Advance to the next element. */
250	count[0]++;
251	base += sstride[0];
252	mbase += mstride[0];
253	dest += dstride[0];
254	n = 0;
255	while (count[n] == extent[n])
256	{
257	/* When we get to the end of a dimension, reset it and increment
258	the next dimension. */
259	count[n] = 0;
260	/* We could precalculate these products, but this is a less
261	frequently used path so proabably not worth it. */
262	base -= sstride[n] * extent[n];
263	mbase -= mstride[n] * extent[n];
264	dest -= dstride[n] * extent[n];
265	n++;
266	if (n == rank)
267	{
268	/* Break out of the look. */
269	base = NULL;
270	break;
271	}
272	else
273	{
274	count[n]++;
275	base += sstride[n];
276	mbase += mstride[n];
277	dest += dstride[n];
278	}
279	}
280	}
281	}
282