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

/* Implementation of the EOSHIFT intrinsic
   Copyright 2002, 2005, 2007, 2009 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 3 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 General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#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;
        }
    }
  else
    {
      if (size0 ((array_t *) ret) == 0)
	return;
    }

  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
748086b7	2	Copyright 2002, 2005, 2007, 2009 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
748086b7	10	version 3 of the License, or (at your option) any later version.
644cb69f FXC	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 General Public License for more details.
	16
748086b7 JJ	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
644cb69f	25
36ae8a61	26	#include "libgfortran.h"
644cb69f FXC	27	#include <stdlib.h>
	28	#include <assert.h>
	29	#include <string.h>
36ae8a61	30
644cb69f FXC	31
	32	#if defined (HAVE_GFC_INTEGER_16)
	33
	34	static void
64acfd99 JB	35	eoshift1 (gfc_array_char * const restrict ret,
	36	const gfc_array_char * const restrict array,
	37	const gfc_array_i16 * const restrict h,
	38	const char * const restrict pbound,
	39	const GFC_INTEGER_16 * const restrict pwhich,
691da334	40	index_type size, const char * filler, index_type filler_len)
644cb69f FXC	41	{
	42	/* r.* indicates the return array. */
	43	index_type rstride[GFC_MAX_DIMENSIONS];
	44	index_type rstride0;
	45	index_type roffset;
	46	char *rptr;
5863aacf	47	char * restrict dest;
644cb69f FXC	48	/* s.* indicates the source array. */
	49	index_type sstride[GFC_MAX_DIMENSIONS];
	50	index_type sstride0;
	51	index_type soffset;
	52	const char *sptr;
	53	const char *src;
	54	/* h.* indicates the shift array. */
	55	index_type hstride[GFC_MAX_DIMENSIONS];
	56	index_type hstride0;
	57	const GFC_INTEGER_16 *hptr;
	58
	59	index_type count[GFC_MAX_DIMENSIONS];
	60	index_type extent[GFC_MAX_DIMENSIONS];
	61	index_type dim;
	62	index_type len;
	63	index_type n;
	64	int which;
	65	GFC_INTEGER_16 sh;
	66	GFC_INTEGER_16 delta;
	67
	68	/* The compiler cannot figure out that these are set, initialize
	69	them to avoid warnings. */
	70	len = 0;
	71	soffset = 0;
	72	roffset = 0;
	73
	74	if (pwhich)
	75	which = *pwhich - 1;
	76	else
	77	which = 0;
	78
	79	extent[0] = 1;
	80	count[0] = 0;
	81
	82	if (ret->data == NULL)
	83	{
	84	int i;
	85
	86	ret->data = internal_malloc_size (size * size0 ((array_t *)array));
	87	ret->offset = 0;
	88	ret->dtype = array->dtype;
	89	for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
	90	{
	91	ret->dim[i].lbound = 0;
	92	ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
	93
	94	if (i == 0)
	95	ret->dim[i].stride = 1;
	96	else
	97	ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
	98	}
	99	}
c44109aa TK	100	else
	101	{
	102	if (size0 ((array_t *) ret) == 0)
	103	return;
	104	}
644cb69f FXC	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