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

/* Implementation of the RESHAPE
   Copyright 2002 Free Software Foundation, Inc.
   Contributed by Paul Brook <paul@nowt.org>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

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 General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */

#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include "libgfortran.h"

#if defined (HAVE_GFC_INTEGER_16)

typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;

/* The shape parameter is ignored. We can currently deduce the shape from the
   return array.  */

extern void reshape_16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, 
	shape_type * const restrict,
	gfc_array_i16 * const restrict, 
	shape_type * const restrict);
export_proto(reshape_16);

void
reshape_16 (gfc_array_i16 * const restrict ret, 
	gfc_array_i16 * const restrict source, 
	shape_type * const restrict shape,
	gfc_array_i16 * const restrict pad, 
	shape_type * const restrict order)
{
  /* r.* indicates the return array.  */
  index_type rcount[GFC_MAX_DIMENSIONS];
  index_type rextent[GFC_MAX_DIMENSIONS];
  index_type rstride[GFC_MAX_DIMENSIONS];
  index_type rstride0;
  index_type rdim;
  index_type rsize;
  index_type rs;
  index_type rex;
  GFC_INTEGER_16 *rptr;
  /* s.* indicates the source array.  */
  index_type scount[GFC_MAX_DIMENSIONS];
  index_type sextent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type sstride0;
  index_type sdim;
  index_type ssize;
  const GFC_INTEGER_16 *sptr;
  /* p.* indicates the pad array.  */
  index_type pcount[GFC_MAX_DIMENSIONS];
  index_type pextent[GFC_MAX_DIMENSIONS];
  index_type pstride[GFC_MAX_DIMENSIONS];
  index_type pdim;
  index_type psize;
  const GFC_INTEGER_16 *pptr;

  const GFC_INTEGER_16 *src;
  int n;
  int dim;

  if (source->dim[0].stride == 0)
    source->dim[0].stride = 1;
  if (shape->dim[0].stride == 0)
    shape->dim[0].stride = 1;
  if (pad && pad->dim[0].stride == 0)
    pad->dim[0].stride = 1;
  if (order && order->dim[0].stride == 0)
    order->dim[0].stride = 1;

  if (ret->data == NULL)
    {
      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
      rs = 1;
      for (n=0; n < rdim; n++)
	{
	  ret->dim[n].lbound = 0;
	  rex = shape->data[n * shape->dim[0].stride];
	  ret->dim[n].ubound =  rex - 1;
	  ret->dim[n].stride = rs;
	  rs *= rex;
	}
      ret->offset = 0;
      ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16));
      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
    }
  else
    {
      rdim = GFC_DESCRIPTOR_RANK (ret);
      if (ret->dim[0].stride == 0)
	ret->dim[0].stride = 1;
    }

  rsize = 1;
  for (n = 0; n < rdim; n++)
    {
      if (order)
        dim = order->data[n * order->dim[0].stride] - 1;
      else
        dim = n;

      rcount[n] = 0;
      rstride[n] = ret->dim[dim].stride;
      rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;

      if (rextent[n] != shape->data[dim * shape->dim[0].stride])
        runtime_error ("shape and target do not conform");

      if (rsize == rstride[n])
        rsize *= rextent[n];
      else
        rsize = 0;
      if (rextent[n] <= 0)
        return;
    }

  sdim = GFC_DESCRIPTOR_RANK (source);
  ssize = 1;
  for (n = 0; n < sdim; n++)
    {
      scount[n] = 0;
      sstride[n] = source->dim[n].stride;
      sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
      if (sextent[n] <= 0)
        abort ();

      if (ssize == sstride[n])
        ssize *= sextent[n];
      else
        ssize = 0;
    }

  if (pad)
    {
      pdim = GFC_DESCRIPTOR_RANK (pad);
      psize = 1;
      for (n = 0; n < pdim; n++)
        {
          pcount[n] = 0;
          pstride[n] = pad->dim[n].stride;
          pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
          if (pextent[n] <= 0)
            abort ();
          if (psize == pstride[n])
            psize *= pextent[n];
          else
            psize = 0;
        }
      pptr = pad->data;
    }
  else
    {
      pdim = 0;
      psize = 1;
      pptr = NULL;
    }

  if (rsize != 0 && ssize != 0 && psize != 0)
    {
      rsize *= sizeof (GFC_INTEGER_16);
      ssize *= sizeof (GFC_INTEGER_16);
      psize *= sizeof (GFC_INTEGER_16);
      reshape_packed ((char *)ret->data, rsize, (char *)source->data,
		      ssize, pad ? (char *)pad->data : NULL, psize);
      return;
    }
  rptr = ret->data;
  src = sptr = source->data;
  rstride0 = rstride[0];
  sstride0 = sstride[0];

  while (rptr)
    {
      /* Select between the source and pad arrays.  */
      *rptr = *src;
      /* Advance to the next element.  */
      rptr += rstride0;
      src += sstride0;
      rcount[0]++;
      scount[0]++;
      /* Advance to the next destination element.  */
      n = 0;
      while (rcount[n] == rextent[n])
        {
          /* When we get to the end of a dimension, reset it and increment
             the next dimension.  */
          rcount[n] = 0;
          /* We could precalculate these products, but this is a less
             frequently used path so proabably not worth it.  */
          rptr -= rstride[n] * rextent[n];
          n++;
          if (n == rdim)
            {
              /* Break out of the loop.  */
              rptr = NULL;
              break;
            }
          else
            {
              rcount[n]++;
              rptr += rstride[n];
            }
        }
      /* Advance to the next source element.  */
      n = 0;
      while (scount[n] == sextent[n])
        {
          /* When we get to the end of a dimension, reset it and increment
             the next dimension.  */
          scount[n] = 0;
          /* We could precalculate these products, but this is a less
             frequently used path so proabably not worth it.  */
          src -= sstride[n] * sextent[n];
          n++;
          if (n == sdim)
            {
              if (sptr && pad)
                {
                  /* Switch to the pad array.  */
                  sptr = NULL;
                  sdim = pdim;
                  for (dim = 0; dim < pdim; dim++)
                    {
                      scount[dim] = pcount[dim];
                      sextent[dim] = pextent[dim];
                      sstride[dim] = pstride[dim];
                      sstride0 = sstride[0];
                    }
                }
              /* We now start again from the beginning of the pad array.  */
              src = pptr;
              break;
            }
          else
            {
              scount[n]++;
              src += sstride[n];
            }
        }
    }
}

#endif
Commit	Line	Data
644cb69f FXC	1	/* Implementation of the RESHAPE
	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 (libgfortran).
	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU General Public
	9	License as published by the Free Software Foundation; either
	10	version 2 of the License, or (at your option) any later version.
	11
	12	In addition to the permissions in the GNU General Public License, the
	13	Free Software Foundation gives you unlimited permission to link the
	14	compiled version of this file into combinations with other programs,
	15	and to distribute those combinations without any restriction coming
	16	from the use of this file. (The General Public License restrictions
	17	do apply in other respects; for example, they cover modification of
	18	the file, and distribution when not linked into a combine
	19	executable.)
	20
	21	Libgfortran is distributed in the hope that it will be useful,
	22	but WITHOUT ANY WARRANTY; without even the implied warranty of
	23	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	24	GNU General Public License for more details.
	25
	26	You should have received a copy of the GNU General Public
	27	License along with libgfortran; see the file COPYING. If not,
	28	write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
	29	Boston, MA 02110-1301, USA. */
	30
	31	#include "config.h"
	32	#include <stdlib.h>
	33	#include <assert.h>
	34	#include "libgfortran.h"
	35
	36	#if defined (HAVE_GFC_INTEGER_16)
	37
	38	typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
	39
	40	/* The shape parameter is ignored. We can currently deduce the shape from the
	41	return array. */
	42
64acfd99 JB	43	extern void reshape_16 (gfc_array_i16 * const restrict,
	44	gfc_array_i16 * const restrict,
	45	shape_type * const restrict,
	46	gfc_array_i16 * const restrict,
	47	shape_type * const restrict);
644cb69f FXC	48	export_proto(reshape_16);
	49
	50	void
64acfd99 JB	51	reshape_16 (gfc_array_i16 * const restrict ret,
	52	gfc_array_i16 * const restrict source,
	53	shape_type * const restrict shape,
	54	gfc_array_i16 * const restrict pad,
	55	shape_type * const restrict order)
644cb69f FXC	56	{
	57	/* r.* indicates the return array. */
	58	index_type rcount[GFC_MAX_DIMENSIONS];
	59	index_type rextent[GFC_MAX_DIMENSIONS];
	60	index_type rstride[GFC_MAX_DIMENSIONS];
	61	index_type rstride0;
	62	index_type rdim;
	63	index_type rsize;
	64	index_type rs;
	65	index_type rex;
	66	GFC_INTEGER_16 *rptr;
	67	/* s.* indicates the source array. */
	68	index_type scount[GFC_MAX_DIMENSIONS];
	69	index_type sextent[GFC_MAX_DIMENSIONS];
	70	index_type sstride[GFC_MAX_DIMENSIONS];
	71	index_type sstride0;
	72	index_type sdim;
	73	index_type ssize;
	74	const GFC_INTEGER_16 *sptr;
	75	/* p.* indicates the pad array. */
	76	index_type pcount[GFC_MAX_DIMENSIONS];
	77	index_type pextent[GFC_MAX_DIMENSIONS];
	78	index_type pstride[GFC_MAX_DIMENSIONS];
	79	index_type pdim;
	80	index_type psize;
	81	const GFC_INTEGER_16 *pptr;
	82
	83	const GFC_INTEGER_16 *src;
	84	int n;
	85	int dim;
	86
	87	if (source->dim[0].stride == 0)
	88	source->dim[0].stride = 1;
	89	if (shape->dim[0].stride == 0)
	90	shape->dim[0].stride = 1;
	91	if (pad && pad->dim[0].stride == 0)
	92	pad->dim[0].stride = 1;
	93	if (order && order->dim[0].stride == 0)
	94	order->dim[0].stride = 1;
	95
	96	if (ret->data == NULL)
	97	{
	98	rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
	99	rs = 1;
	100	for (n=0; n < rdim; n++)
	101	{
	102	ret->dim[n].lbound = 0;
	103	rex = shape->data[n * shape->dim[0].stride];
	104	ret->dim[n].ubound = rex - 1;
	105	ret->dim[n].stride = rs;
	106	rs *= rex;
	107	}
	108	ret->offset = 0;
	109	ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16));
	110	ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) \| rdim;
	111	}
	112	else
	113	{
	114	rdim = GFC_DESCRIPTOR_RANK (ret);
	115	if (ret->dim[0].stride == 0)
	116	ret->dim[0].stride = 1;
	117	}
	118
	119	rsize = 1;
120	for (n = 0; n < rdim; n++)
121	{
122	if (order)
123	dim = order->data[n * order->dim[0].stride] - 1;
124	else
125	dim = n;
126
127	rcount[n] = 0;
128	rstride[n] = ret->dim[dim].stride;
129	rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
130
131	if (rextent[n] != shape->data[dim * shape->dim[0].stride])
132	runtime_error ("shape and target do not conform");
133
134	if (rsize == rstride[n])
135	rsize *= rextent[n];
136	else
137	rsize = 0;
138	if (rextent[n] <= 0)
139	return;
140	}
141
142	sdim = GFC_DESCRIPTOR_RANK (source);
143	ssize = 1;
144	for (n = 0; n < sdim; n++)
145	{
146	scount[n] = 0;
147	sstride[n] = source->dim[n].stride;
148	sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
149	if (sextent[n] <= 0)
150	abort ();
151
152	if (ssize == sstride[n])
153	ssize *= sextent[n];
154	else
155	ssize = 0;
156	}
157
158	if (pad)
159	{
160	pdim = GFC_DESCRIPTOR_RANK (pad);
161	psize = 1;
162	for (n = 0; n < pdim; n++)
163	{
164	pcount[n] = 0;
165	pstride[n] = pad->dim[n].stride;
166	pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
167	if (pextent[n] <= 0)
168	abort ();
169	if (psize == pstride[n])
170	psize *= pextent[n];
171	else
172	psize = 0;
173	}
174	pptr = pad->data;
175	}
176	else
177	{
178	pdim = 0;
179	psize = 1;
180	pptr = NULL;
181	}
182
183	if (rsize != 0 && ssize != 0 && psize != 0)
184	{
185	rsize *= sizeof (GFC_INTEGER_16);
186	ssize *= sizeof (GFC_INTEGER_16);
187	psize *= sizeof (GFC_INTEGER_16);
188	reshape_packed ((char )ret->data, rsize, (char )source->data,
189	ssize, pad ? (char *)pad->data : NULL, psize);
190	return;
191	}
192	rptr = ret->data;
193	src = sptr = source->data;
194	rstride0 = rstride[0];
195	sstride0 = sstride[0];
196
197	while (rptr)
198	{
199	/* Select between the source and pad arrays. */
200	rptr = src;
201	/* Advance to the next element. */
202	rptr += rstride0;
203	src += sstride0;
204	rcount[0]++;
205	scount[0]++;
206	/* Advance to the next destination element. */
207	n = 0;
208	while (rcount[n] == rextent[n])
209	{
210	/* When we get to the end of a dimension, reset it and increment
211	the next dimension. */
212	rcount[n] = 0;
213	/* We could precalculate these products, but this is a less
214	frequently used path so proabably not worth it. */
215	rptr -= rstride[n] * rextent[n];
216	n++;
217	if (n == rdim)
218	{
219	/* Break out of the loop. */
220	rptr = NULL;
221	break;
222	}
223	else
224	{
225	rcount[n]++;
226	rptr += rstride[n];
227	}
228	}
229	/* Advance to the next source element. */
230	n = 0;
231	while (scount[n] == sextent[n])
232	{
233	/* When we get to the end of a dimension, reset it and increment
234	the next dimension. */
235	scount[n] = 0;
236	/* We could precalculate these products, but this is a less
237	frequently used path so proabably not worth it. */
238	src -= sstride[n] * sextent[n];
239	n++;
240	if (n == sdim)
241	{
242	if (sptr && pad)
243	{
244	/* Switch to the pad array. */
245	sptr = NULL;
246	sdim = pdim;
247	for (dim = 0; dim < pdim; dim++)
248	{
249	scount[dim] = pcount[dim];
250	sextent[dim] = pextent[dim];
251	sstride[dim] = pstride[dim];
252	sstride0 = sstride[0];
253	}
254	}
255	/* We now start again from the beginning of the pad array. */
256	src = pptr;
257	break;
258	}
259	else
260	{
261	scount[n]++;
262	src += sstride[n];
263	}
264	}
265	}
266	}
267
268	#endif