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

/* Implementation of the EOSHIFT intrinsic
   Copyright 2002, 2005, 2007 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 "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>


#if defined (HAVE_GFC_INTEGER_16)

static void
eoshift1 (gfc_array_char * const restrict ret, 
	const gfc_array_char * const restrict array, 
	const gfc_array_i16 * const restrict h,
	const char * const restrict pbound, 
	const GFC_INTEGER_16 * const restrict pwhich, 
	index_type size, const char * filler, index_type filler_len)
{
  /* r.* indicates the return array.  */
  index_type rstride[GFC_MAX_DIMENSIONS];
  index_type rstride0;
  index_type roffset;
  char *rptr;
  char * restrict dest;
  /* s.* indicates the source array.  */
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type sstride0;
  index_type soffset;
  const char *sptr;
  const char *src;
  /* h.* indicates the shift array.  */
  index_type hstride[GFC_MAX_DIMENSIONS];
  index_type hstride0;
  const GFC_INTEGER_16 *hptr;

  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dim;
  index_type len;
  index_type n;
  int which;
  GFC_INTEGER_16 sh;
  GFC_INTEGER_16 delta;

  /* The compiler cannot figure out that these are set, initialize
     them to avoid warnings.  */
  len = 0;
  soffset = 0;
  roffset = 0;

  if (pwhich)
    which = *pwhich - 1;
  else
    which = 0;

  extent[0] = 1;
  count[0] = 0;

  if (ret->data == NULL)
    {
      int i;

      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
      ret->offset = 0;
      ret->dtype = array->dtype;
      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
        {
          ret->dim[i].lbound = 0;
          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;

          if (i == 0)
            ret->dim[i].stride = 1;
          else
            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
        }
    }

  n = 0;
  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
    {
      if (dim == which)
        {
          roffset = ret->dim[dim].stride * size;
          if (roffset == 0)
            roffset = size;
          soffset = array->dim[dim].stride * size;
          if (soffset == 0)
            soffset = size;
          len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
        }
      else
        {
          count[n] = 0;
          extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
          rstride[n] = ret->dim[dim].stride * size;
          sstride[n] = array->dim[dim].stride * size;

          hstride[n] = h->dim[n].stride;
          n++;
        }
    }
  if (sstride[0] == 0)
    sstride[0] = size;
  if (rstride[0] == 0)
    rstride[0] = size;
  if (hstride[0] == 0)
    hstride[0] = 1;

  dim = GFC_DESCRIPTOR_RANK (array);
  rstride0 = rstride[0];
  sstride0 = sstride[0];
  hstride0 = hstride[0];
  rptr = ret->data;
  sptr = array->data;
  hptr = h->data;

  while (rptr)
    {
      /* Do the shift for this dimension.  */
      sh = *hptr;
      if (( sh >= 0 ? sh : -sh ) > len)
	{
	  delta = len;
	  sh = len;
	}
      else
	delta = (sh >= 0) ? sh: -sh;

      if (sh > 0)
        {
          src = &sptr[delta * soffset];
          dest = rptr;
        }
      else
        {
          src = sptr;
          dest = &rptr[delta * roffset];
        }
      for (n = 0; n < len - delta; n++)
        {
          memcpy (dest, src, size);
          dest += roffset;
          src += soffset;
        }
      if (sh < 0)
        dest = rptr;
      n = delta;

      if (pbound)
	while (n--)
	  {
	    memcpy (dest, pbound, size);
	    dest += roffset;
	  }
      else
	while (n--)
	  {
	    index_type i;

	    if (filler_len == 1)
	      memset (dest, filler[0], size);
	    else
	      for (i = 0; i < size; i += filler_len)
		memcpy (&dest[i], filler, filler_len);

	    dest += roffset;
	  }

      /* Advance to the next section.  */
      rptr += rstride0;
      sptr += sstride0;
      hptr += hstride0;
      count[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 probably not worth it.  */
          rptr -= rstride[n] * extent[n];
          sptr -= sstride[n] * extent[n];
	  hptr -= hstride[n] * extent[n];
          n++;
          if (n >= dim - 1)
            {
              /* Break out of the loop.  */
              rptr = NULL;
              break;
            }
          else
            {
              count[n]++;
              rptr += rstride[n];
              sptr += sstride[n];
	      hptr += hstride[n];
            }
        }
    }
}

void eoshift1_16 (gfc_array_char * const restrict, 
	const gfc_array_char * const restrict,
	const gfc_array_i16 * const restrict, const char * const restrict, 
	const GFC_INTEGER_16 * const restrict);
export_proto(eoshift1_16);

void
eoshift1_16 (gfc_array_char * const restrict ret, 
	const gfc_array_char * const restrict array,
	const gfc_array_i16 * const restrict h, 
	const char * const restrict pbound,
	const GFC_INTEGER_16 * const restrict pwhich)
{
  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
	    "\0", 1);
}


void eoshift1_16_char (gfc_array_char * const restrict, 
	GFC_INTEGER_4,
	const gfc_array_char * const restrict, 
	const gfc_array_i16 * const restrict,
	const char * const restrict, 
	const GFC_INTEGER_16 * const restrict,
	GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(eoshift1_16_char);

void
eoshift1_16_char (gfc_array_char * const restrict ret,
	GFC_INTEGER_4 ret_length __attribute__((unused)),
	const gfc_array_char * const restrict array, 
	const gfc_array_i16 * const restrict h,
	const char *  const restrict pbound, 
	const GFC_INTEGER_16 * const restrict pwhich,
	GFC_INTEGER_4 array_length,
	GFC_INTEGER_4 bound_length __attribute__((unused)))
{
  eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
}


void eoshift1_16_char4 (gfc_array_char * const restrict, 
	GFC_INTEGER_4,
	const gfc_array_char * const restrict, 
	const gfc_array_i16 * const restrict,
	const char * const restrict, 
	const GFC_INTEGER_16 * const restrict,
	GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(eoshift1_16_char4);

void
eoshift1_16_char4 (gfc_array_char * const restrict ret,
	GFC_INTEGER_4 ret_length __attribute__((unused)),
	const gfc_array_char * const restrict array, 
	const gfc_array_i16 * const restrict h,
	const char *  const restrict pbound, 
	const GFC_INTEGER_16 * const restrict pwhich,
	GFC_INTEGER_4 array_length,
	GFC_INTEGER_4 bound_length __attribute__((unused)))
{
  static const gfc_char4_t space = (unsigned char) ' ';
  eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
	    (const char *) &space, sizeof (gfc_char4_t));
}

#endif
Commit	Line	Data
644cb69f	1	/* Implementation of the EOSHIFT intrinsic
36ae8a61	2	Copyright 2002, 2005, 2007 Free Software Foundation, Inc.
644cb69f FXC	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
36ae8a61	31	#include "libgfortran.h"
644cb69f FXC	32	#include <stdlib.h>
	33	#include <assert.h>
	34	#include <string.h>
36ae8a61	35
644cb69f FXC	36
	37	#if defined (HAVE_GFC_INTEGER_16)
	38
	39	static void
64acfd99 JB	40	eoshift1 (gfc_array_char * const restrict ret,
	41	const gfc_array_char * const restrict array,
	42	const gfc_array_i16 * const restrict h,
	43	const char * const restrict pbound,
	44	const GFC_INTEGER_16 * const restrict pwhich,
691da334	45	index_type size, const char * filler, index_type filler_len)
644cb69f FXC	46	{
	47	/* r.* indicates the return array. */
	48	index_type rstride[GFC_MAX_DIMENSIONS];
	49	index_type rstride0;
	50	index_type roffset;
	51	char *rptr;
5863aacf	52	char * restrict dest;
644cb69f FXC	53	/* s.* indicates the source array. */
	54	index_type sstride[GFC_MAX_DIMENSIONS];
	55	index_type sstride0;
	56	index_type soffset;
	57	const char *sptr;
	58	const char *src;
	59	/* h.* indicates the shift array. */
	60	index_type hstride[GFC_MAX_DIMENSIONS];
	61	index_type hstride0;
	62	const GFC_INTEGER_16 *hptr;
	63
	64	index_type count[GFC_MAX_DIMENSIONS];
	65	index_type extent[GFC_MAX_DIMENSIONS];
	66	index_type dim;
	67	index_type len;
	68	index_type n;
	69	int which;
	70	GFC_INTEGER_16 sh;
	71	GFC_INTEGER_16 delta;
	72
	73	/* The compiler cannot figure out that these are set, initialize
	74	them to avoid warnings. */
	75	len = 0;
	76	soffset = 0;
	77	roffset = 0;
	78
	79	if (pwhich)
	80	which = *pwhich - 1;
	81	else
	82	which = 0;
	83
	84	extent[0] = 1;
	85	count[0] = 0;
	86
	87	if (ret->data == NULL)
	88	{
	89	int i;
	90
	91	ret->data = internal_malloc_size (size * size0 ((array_t *)array));
	92	ret->offset = 0;
	93	ret->dtype = array->dtype;
	94	for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
	95	{
	96	ret->dim[i].lbound = 0;
	97	ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
	98
	99	if (i == 0)
	100	ret->dim[i].stride = 1;
	101	else
	102	ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
	103	}
	104	}
	105
	106	n = 0;
	107	for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
	108	{
	109	if (dim == which)
	110	{
	111	roffset = ret->dim[dim].stride * size;
	112	if (roffset == 0)
	113	roffset = size;
	114	soffset = array->dim[dim].stride * size;
	115	if (soffset == 0)
	116	soffset = size;
117	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
118	}
119	else
120	{
121	count[n] = 0;
122	extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
123	rstride[n] = ret->dim[dim].stride * size;
124	sstride[n] = array->dim[dim].stride * size;
125
126	hstride[n] = h->dim[n].stride;
127	n++;
128	}
129	}
130	if (sstride[0] == 0)
131	sstride[0] = size;
132	if (rstride[0] == 0)
133	rstride[0] = size;
134	if (hstride[0] == 0)
135	hstride[0] = 1;
136
137	dim = GFC_DESCRIPTOR_RANK (array);
138	rstride0 = rstride[0];
139	sstride0 = sstride[0];
140	hstride0 = hstride[0];
141	rptr = ret->data;
142	sptr = array->data;
143	hptr = h->data;
144
145	while (rptr)
146	{
147	/* Do the shift for this dimension. */
148	sh = *hptr;
149	if (( sh >= 0 ? sh : -sh ) > len)
150	{
151	delta = len;
152	sh = len;
153	}
154	else
155	delta = (sh >= 0) ? sh: -sh;
156
157	if (sh > 0)
158	{
159	src = &sptr[delta * soffset];
160	dest = rptr;
161	}
162	else
163	{
164	src = sptr;
165	dest = &rptr[delta * roffset];
166	}
167	for (n = 0; n < len - delta; n++)
168	{
169	memcpy (dest, src, size);
170	dest += roffset;
171	src += soffset;
172	}
173	if (sh < 0)
174	dest = rptr;
175	n = delta;
176
177	if (pbound)
178	while (n--)
179	{
180	memcpy (dest, pbound, size);
181	dest += roffset;
182	}
183	else
184	while (n--)
185	{
691da334 FXC	186	index_type i;
	187
	188	if (filler_len == 1)
	189	memset (dest, filler[0], size);
	190	else
	191	for (i = 0; i < size; i += filler_len)
	192	memcpy (&dest[i], filler, filler_len);
	193
644cb69f FXC	194	dest += roffset;
	195	}
	196
	197	/* Advance to the next section. */
	198	rptr += rstride0;
	199	sptr += sstride0;
	200	hptr += hstride0;
	201	count[0]++;
	202	n = 0;
	203	while (count[n] == extent[n])
	204	{
	205	/* When we get to the end of a dimension, reset it and increment
	206	the next dimension. */
	207	count[n] = 0;
	208	/* We could precalculate these products, but this is a less
5d7adf7a	209	frequently used path so probably not worth it. */
644cb69f FXC	210	rptr -= rstride[n] * extent[n];
	211	sptr -= sstride[n] * extent[n];
	212	hptr -= hstride[n] * extent[n];
	213	n++;
	214	if (n >= dim - 1)
	215	{
	216	/* Break out of the loop. */
	217	rptr = NULL;
	218	break;
	219	}
	220	else
	221	{
	222	count[n]++;
	223	rptr += rstride[n];
	224	sptr += sstride[n];
	225	hptr += hstride[n];
	226	}
	227	}
	228	}
	229	}
	230
64acfd99 JB	231	void eoshift1_16 (gfc_array_char * const restrict,
	232	const gfc_array_char * const restrict,
	233	const gfc_array_i16 * const restrict, const char * const restrict,
	234	const GFC_INTEGER_16 * const restrict);
644cb69f FXC	235	export_proto(eoshift1_16);
	236
	237	void
64acfd99 JB	238	eoshift1_16 (gfc_array_char * const restrict ret,
	239	const gfc_array_char * const restrict array,
	240	const gfc_array_i16 * const restrict h,
	241	const char * const restrict pbound,
	242	const GFC_INTEGER_16 * const restrict pwhich)
644cb69f	243	{
691da334 FXC	244	eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array),
691da334 FXC	245	"\0", 1);
644cb69f FXC	246	}
644cb69f FXC	247
691da334	248
64acfd99 JB	249	void eoshift1_16_char (gfc_array_char * const restrict,
	250	GFC_INTEGER_4,
	251	const gfc_array_char * const restrict,
	252	const gfc_array_i16 * const restrict,
	253	const char * const restrict,
	254	const GFC_INTEGER_16 * const restrict,
	255	GFC_INTEGER_4, GFC_INTEGER_4);
644cb69f FXC	256	export_proto(eoshift1_16_char);
	257
	258	void
64acfd99 JB	259	eoshift1_16_char (gfc_array_char * const restrict ret,
	260	GFC_INTEGER_4 ret_length __attribute__((unused)),
	261	const gfc_array_char * const restrict array,
	262	const gfc_array_i16 * const restrict h,
	263	const char * const restrict pbound,
	264	const GFC_INTEGER_16 * const restrict pwhich,
	265	GFC_INTEGER_4 array_length,
	266	GFC_INTEGER_4 bound_length __attribute__((unused)))
644cb69f	267	{
691da334 FXC	268	eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1);
	269	}
	270
	271
	272	void eoshift1_16_char4 (gfc_array_char * const restrict,
	273	GFC_INTEGER_4,
	274	const gfc_array_char * const restrict,
	275	const gfc_array_i16 * const restrict,
	276	const char * const restrict,
	277	const GFC_INTEGER_16 * const restrict,
	278	GFC_INTEGER_4, GFC_INTEGER_4);
	279	export_proto(eoshift1_16_char4);
	280
	281	void
	282	eoshift1_16_char4 (gfc_array_char * const restrict ret,
	283	GFC_INTEGER_4 ret_length __attribute__((unused)),
	284	const gfc_array_char * const restrict array,
	285	const gfc_array_i16 * const restrict h,
	286	const char * const restrict pbound,
	287	const GFC_INTEGER_16 * const restrict pwhich,
	288	GFC_INTEGER_4 array_length,
	289	GFC_INTEGER_4 bound_length __attribute__((unused)))
	290	{
	291	static const gfc_char4_t space = (unsigned char) ' ';
	292	eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t),
	293	(const char *) &space, sizeof (gfc_char4_t));
644cb69f FXC	294	}
	295
	296	#endif