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

  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
	66	for (n = 0; n < rank; n++)
	67	{
	68	count[n] = 0;
	69	dstride[n] = retarray->dim[n].stride;
	70	if (extent[n] <= 0)
	71	len = 0;
	72	}
	73
	74	base = array->data;
	75	dest = retarray->data;
	76
	77	while (base)
	78	{
	79	GFC_INTEGER_4 *src;
	80	GFC_INTEGER_4 result;
	81	src = base;
	82	{
	83
	84	result = 1;
	85	if (len <= 0)
	86	*dest = 1;
	87	else
	88	{
	89	for (n = 0; n < len; n++, src += delta)
	90	{
91
92	result = src;
93	}
94	*dest = result;
95	}
96	}
97	/* Advance to the next element. */
98	count[0]++;
99	base += sstride[0];
100	dest += dstride[0];
101	n = 0;
102	while (count[n] == extent[n])
103	{
104	/* When we get to the end of a dimension, reset it and increment
105	the next dimension. */
106	count[n] = 0;
107	/* We could precalculate these products, but this is a less
108	frequently used path so proabably not worth it. */
109	base -= sstride[n] * extent[n];
110	dest -= dstride[n] * extent[n];
111	n++;
112	if (n == rank)
113	{
114	/* Break out of the look. */
115	base = NULL;
116	break;
117	}
118	else
119	{
120	count[n]++;
121	base += sstride[n];
122	dest += dstride[n];
123	}
124	}
125	}
126	}
127
128	void
129	__mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type pdim, gfc_array_l4 mask)
130	{
131	index_type count[GFC_MAX_DIMENSIONS - 1];
132	index_type extent[GFC_MAX_DIMENSIONS - 1];
133	index_type sstride[GFC_MAX_DIMENSIONS - 1];
134	index_type dstride[GFC_MAX_DIMENSIONS - 1];
135	index_type mstride[GFC_MAX_DIMENSIONS - 1];
136	GFC_INTEGER_4 *dest;
137	GFC_INTEGER_4 *base;
138	GFC_LOGICAL_4 *mbase;
139	int rank;
140	int dim;
141	index_type n;
142	index_type len;
143	index_type delta;
144	index_type mdelta;
145
146	dim = (*pdim) - 1;
147	rank = GFC_DESCRIPTOR_RANK (array) - 1;
148	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
149	if (array->dim[0].stride == 0)
150	array->dim[0].stride = 1;
151	if (retarray->dim[0].stride == 0)
152	retarray->dim[0].stride = 1;
153
154	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
155	if (len <= 0)
156	return;
157	delta = array->dim[dim].stride;
158	mdelta = mask->dim[dim].stride;
159
160	for (n = 0; n < dim; n++)
161	{
162	sstride[n] = array->dim[n].stride;
163	mstride[n] = mask->dim[n].stride;
164	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
165	}
166	for (n = dim; n < rank; n++)
167	{
168	sstride[n] = array->dim[n + 1].stride;
169	mstride[n] = mask->dim[n + 1].stride;
170	extent[n] =
171	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
172	}
173
174	for (n = 0; n < rank; n++)
175	{
176	count[n] = 0;
177	dstride[n] = retarray->dim[n].stride;
178	if (extent[n] <= 0)
179	return;
180	}
181
182	dest = retarray->data;
183	base = array->data;
184	mbase = mask->data;
185
186	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
187	{
188	/* This allows the same loop to be used for all logical types. */
189	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
190	for (n = 0; n < rank; n++)
191	mstride[n] <<= 1;
192	mdelta <<= 1;
193	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
194	}
195
196	while (base)
197	{
198	GFC_INTEGER_4 *src;
199	GFC_LOGICAL_4 *msrc;
200	GFC_INTEGER_4 result;
201	src = base;
202	msrc = mbase;
203	{
204
205	result = 1;
206	if (len <= 0)
207	*dest = 1;
208	else
209	{
210	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
211	{
212
213	if (*msrc)
214	result = src;
215	}
216	*dest = result;
217	}
218	}
219	/* Advance to the next element. */
220	count[0]++;
221	base += sstride[0];
222	mbase += mstride[0];
223	dest += dstride[0];
224	n = 0;
225	while (count[n] == extent[n])
226	{
227	/* When we get to the end of a dimension, reset it and increment
228	the next dimension. */
229	count[n] = 0;
230	/* We could precalculate these products, but this is a less
231	frequently used path so proabably not worth it. */
232	base -= sstride[n] * extent[n];
233	mbase -= mstride[n] * extent[n];
234	dest -= dstride[n] * extent[n];
235	n++;
236	if (n == rank)
237	{
238	/* Break out of the look. */
239	base = NULL;
240	break;
241	}
242	else
243	{
244	count[n]++;
245	base += sstride[n];
246	mbase += mstride[n];
247	dest += dstride[n];
248	}
249	}
250	}
251	}
252