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

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

void
__product_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 = 1;
        if (len <= 0)
	  *dest = 1;
	else
	  {
	    for (n = 0; n < len; n++, src += delta)
	      {

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

void
__mproduct_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 = 1;
        if (len <= 0)
	  *dest = 1;
	else
	  {
	    for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	      {

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