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

/* Implementation of the SUM 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
__sum_i8 (gfc_array_i8 * retarray, gfc_array_i8 *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_8 *base;
  GFC_INTEGER_8 *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_8 *src;
      GFC_INTEGER_8 result;
      src = base;
      {

  result = 0;
        if (len <= 0)
	  *dest = 0;
	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
__msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * 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_8 *dest;
  GFC_INTEGER_8 *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_8 *src;
      GFC_LOGICAL_4 *msrc;
      GFC_INTEGER_8 result;
      src = base;
      msrc = mbase;
      {

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