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

/* Implementation of the MINVAL 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 minval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(minval_i4);

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

void
mminval_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 MINVAL 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	28
7f68c75f RH	29	extern void minval_i4 (gfc_array_i4 , gfc_array_i4 , index_type *);
7f68c75f RH	30	export_proto(minval_i4);
7d7b8bfe	31
6de9cd9a	32	void
7f68c75f	33	minval_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	153
7f68c75f RH	154	extern void mminval_i4 (gfc_array_i4 , gfc_array_i4 , index_type *,
	155	gfc_array_l4 *);
	156	export_proto(mminval_i4);
7d7b8bfe	157
6de9cd9a	158	void
7f68c75f RH	159	mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
7f68c75f RH	160	index_type pdim, gfc_array_l4 mask)
6de9cd9a DN	161	{
	162	index_type count[GFC_MAX_DIMENSIONS - 1];
	163	index_type extent[GFC_MAX_DIMENSIONS - 1];
	164	index_type sstride[GFC_MAX_DIMENSIONS - 1];
	165	index_type dstride[GFC_MAX_DIMENSIONS - 1];
	166	index_type mstride[GFC_MAX_DIMENSIONS - 1];
	167	GFC_INTEGER_4 *dest;
	168	GFC_INTEGER_4 *base;
	169	GFC_LOGICAL_4 *mbase;
	170	int rank;
	171	int dim;
	172	index_type n;
	173	index_type len;
	174	index_type delta;
	175	index_type mdelta;
	176
	177	dim = (*pdim) - 1;
	178	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	179	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
	180	if (array->dim[0].stride == 0)
	181	array->dim[0].stride = 1;
	182	if (retarray->dim[0].stride == 0)
	183	retarray->dim[0].stride = 1;
	184
	185	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	186	if (len <= 0)
	187	return;
	188	delta = array->dim[dim].stride;
	189	mdelta = mask->dim[dim].stride;
	190
	191	for (n = 0; n < dim; n++)
	192	{
	193	sstride[n] = array->dim[n].stride;
	194	mstride[n] = mask->dim[n].stride;
	195	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	196	}
	197	for (n = dim; n < rank; n++)
	198	{
	199	sstride[n] = array->dim[n + 1].stride;
	200	mstride[n] = mask->dim[n + 1].stride;
	201	extent[n] =
	202	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	203	}
	204
	205	for (n = 0; n < rank; n++)
	206	{
	207	count[n] = 0;
	208	dstride[n] = retarray->dim[n].stride;
	209	if (extent[n] <= 0)
	210	return;
	211	}
	212
	213	dest = retarray->data;
	214	base = array->data;
	215	mbase = mask->data;
	216
	217	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	218	{
	219	/* This allows the same loop to be used for all logical types. */
	220	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	221	for (n = 0; n < rank; n++)
	222	mstride[n] <<= 1;
	223	mdelta <<= 1;
	224	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
225	}
226
227	while (base)
228	{
229	GFC_INTEGER_4 *src;
230	GFC_LOGICAL_4 *msrc;
231	GFC_INTEGER_4 result;
232	src = base;
233	msrc = mbase;
234	{
235
236	result = GFC_INTEGER_4_HUGE;
237	if (len <= 0)
238	*dest = GFC_INTEGER_4_HUGE;
239	else
240	{
241	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
242	{
243
244	if (msrc && src < result)
245	result = *src;
246	}
247	*dest = result;
248	}
249	}
250	/* Advance to the next element. */
251	count[0]++;
252	base += sstride[0];
253	mbase += mstride[0];
254	dest += dstride[0];
255	n = 0;
256	while (count[n] == extent[n])
257	{
258	/* When we get to the end of a dimension, reset it and increment
259	the next dimension. */
260	count[n] = 0;
261	/* We could precalculate these products, but this is a less
262	frequently used path so proabably not worth it. */
263	base -= sstride[n] * extent[n];
264	mbase -= mstride[n] * extent[n];
265	dest -= dstride[n] * extent[n];
266	n++;
267	if (n == rank)
268	{
269	/* Break out of the look. */
270	base = NULL;
271	break;
272	}
273	else
274	{
275	count[n]++;
276	base += sstride[n];
277	mbase += mstride[n];
278	dest += dstride[n];
279	}
280	}
281	}
282	}
283