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

/* Implementation of the EOSHIFT intrinsic
   Copyright (C) 2002-2016 Free Software Foundation, Inc.
   Contributed by Paul Brook <paul@nowt.org>

This file is part of the GNU Fortran 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_4)

static void
eoshift3 (gfc_array_char * const restrict ret, 
	const gfc_array_char * const restrict array, 
	const gfc_array_i4 * const restrict h,
	const gfc_array_char * const restrict bound, 
	const GFC_INTEGER_4 * const restrict pwhich,
	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_4 *hptr;
  /* b.* indicates the bound array.  */
  index_type bstride[GFC_MAX_DIMENSIONS];
  index_type bstride0;
  const char *bptr;

  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dim;
  index_type len;
  index_type n;
  index_type size;
  index_type arraysize;
  int which;
  GFC_INTEGER_4 sh;
  GFC_INTEGER_4 delta;

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

  arraysize = size0 ((array_t *) array);
  size = GFC_DESCRIPTOR_SIZE(array);

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

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

      ret->base_addr = xmallocarray (arraysize, size);
      ret->offset = 0;
      ret->dtype = array->dtype;
      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
        {
	  index_type ub, str;

	  ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;

          if (i == 0)
            str = 1;
          else
            str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
	      * GFC_DESCRIPTOR_STRIDE(ret,i-1);

	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);

        }
      /* xmallocarray allocates a single byte for zero size.  */
      ret->base_addr = xmallocarray (arraysize, size);

    }
  else if (unlikely (compile_options.bounds_check))
    {
      bounds_equal_extents ((array_t *) ret, (array_t *) array,
				 "return value", "EOSHIFT");
    }

  if (unlikely (compile_options.bounds_check))
    {
      bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
      			      "SHIFT argument", "EOSHIFT");
    }

  if (arraysize == 0)
    return;

  extent[0] = 1;
  count[0] = 0;
  n = 0;
  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
    {
      if (dim == which)
        {
          roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
          if (roffset == 0)
            roffset = size;
          soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
          if (soffset == 0)
            soffset = size;
          len = GFC_DESCRIPTOR_EXTENT(array,dim);
        }
      else
        {
          count[n] = 0;
          extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
          rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
          sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);

          hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
          if (bound)
            bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
          else
            bstride[n] = 0;
          n++;
        }
    }
  if (sstride[0] == 0)
    sstride[0] = size;
  if (rstride[0] == 0)
    rstride[0] = size;
  if (hstride[0] == 0)
    hstride[0] = 1;
  if (bound && bstride[0] == 0)
    bstride[0] = size;

  dim = GFC_DESCRIPTOR_RANK (array);
  rstride0 = rstride[0];
  sstride0 = sstride[0];
  hstride0 = hstride[0];
  bstride0 = bstride[0];
  rptr = ret->base_addr;
  sptr = array->base_addr;
  hptr = h->base_addr;
  if (bound)
    bptr = bound->base_addr;
  else
    bptr = NULL;

  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 (bptr)
	while (n--)
	  {
	    memcpy (dest, bptr, 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;
      bptr += bstride0;
      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];
          bptr -= bstride[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];
              bptr += bstride[n];
            }
        }
    }
}

extern void eoshift3_4 (gfc_array_char * const restrict, 
	const gfc_array_char * const restrict,
	const gfc_array_i4 * const restrict, 
	const gfc_array_char * const restrict,
	const GFC_INTEGER_4 *);
export_proto(eoshift3_4);

void
eoshift3_4 (gfc_array_char * const restrict ret, 
	const gfc_array_char * const restrict array,
	const gfc_array_i4 * const restrict h, 
	const gfc_array_char * const restrict bound,
	const GFC_INTEGER_4 * const restrict pwhich)
{
  eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
}


extern void eoshift3_4_char (gfc_array_char * const restrict, 
	GFC_INTEGER_4,
	const gfc_array_char * const restrict,
	const gfc_array_i4 * const restrict,
	const gfc_array_char * const restrict,
	const GFC_INTEGER_4 * const restrict, 
	GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(eoshift3_4_char);

void
eoshift3_4_char (gfc_array_char * const restrict ret,
	GFC_INTEGER_4 ret_length __attribute__((unused)),
	const gfc_array_char * const restrict array, 
	const gfc_array_i4 *  const restrict h,
	const gfc_array_char * const restrict bound,
	const GFC_INTEGER_4 * const restrict pwhich,
	GFC_INTEGER_4 array_length __attribute__((unused)),
	GFC_INTEGER_4 bound_length __attribute__((unused)))
{
  eoshift3 (ret, array, h, bound, pwhich, " ", 1);
}


extern void eoshift3_4_char4 (gfc_array_char * const restrict, 
	GFC_INTEGER_4,
	const gfc_array_char * const restrict,
	const gfc_array_i4 * const restrict,
	const gfc_array_char * const restrict,
	const GFC_INTEGER_4 * const restrict, 
	GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(eoshift3_4_char4);

void
eoshift3_4_char4 (gfc_array_char * const restrict ret,
	GFC_INTEGER_4 ret_length __attribute__((unused)),
	const gfc_array_char * const restrict array, 
	const gfc_array_i4 *  const restrict h,
	const gfc_array_char * const restrict bound,
	const GFC_INTEGER_4 * const restrict pwhich,
	GFC_INTEGER_4 array_length __attribute__((unused)),
	GFC_INTEGER_4 bound_length __attribute__((unused)))
{
  static const gfc_char4_t space = (unsigned char) ' ';
  eoshift3 (ret, array, h, bound, pwhich,
	    (const char *) &space, sizeof (gfc_char4_t));
}

#endif
Commit	Line	Data
4ee9c684	1	/* Implementation of the EOSHIFT intrinsic
f1717362	2	Copyright (C) 2002-2016 Free Software Foundation, Inc.
4ee9c684	3	Contributed by Paul Brook <paul@nowt.org>
4ee9c684	4
553877d9	5	This file is part of the GNU Fortran runtime library (libgfortran).
4ee9c684	6
b417ea8c	7	Libgfortran is free software; you can redistribute it and/or
b417ea8c	8	modify it under the terms of the GNU General Public
4ee9c684	9	License as published by the Free Software Foundation; either
6bc9506f	10	version 3 of the License, or (at your option) any later version.
b417ea8c	11
b417ea8c	12	Libgfortran is distributed in the hope that it will be useful,
4ee9c684	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
4ee9c684	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
b417ea8c	15	GNU General Public License for more details.
4ee9c684	16
6bc9506f	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/>. */
4ee9c684	25
41f2d5e8	26	#include "libgfortran.h"
4ee9c684	27	#include <stdlib.h>
	28	#include <assert.h>
	29	#include <string.h>
41f2d5e8	30
4ee9c684	31
920e54ef	32	#if defined (HAVE_GFC_INTEGER_4)
920e54ef	33
1a9a4a12	34	static void
b4cafd67	35	eoshift3 (gfc_array_char * const restrict ret,
	36	const gfc_array_char * const restrict array,
	37	const gfc_array_i4 * const restrict h,
	38	const gfc_array_char * const restrict bound,
	39	const GFC_INTEGER_4 * const restrict pwhich,
827aef63	40	const char * filler, index_type filler_len)
4ee9c684	41	{
4ee9c684	42	/* r.* indicates the return array. */
9130521e	43	index_type rstride[GFC_MAX_DIMENSIONS];
4ee9c684	44	index_type rstride0;
	45	index_type roffset;
	46	char *rptr;
9d259edf	47	char * restrict dest;
4ee9c684	48	/* s.* indicates the source array. */
9130521e	49	index_type sstride[GFC_MAX_DIMENSIONS];
4ee9c684	50	index_type sstride0;
	51	index_type soffset;
	52	const char *sptr;
	53	const char *src;
	54	/* h.* indicates the shift array. */
9130521e	55	index_type hstride[GFC_MAX_DIMENSIONS];
4ee9c684	56	index_type hstride0;
	57	const GFC_INTEGER_4 *hptr;
	58	/* b.* indicates the bound array. */
9130521e	59	index_type bstride[GFC_MAX_DIMENSIONS];
4ee9c684	60	index_type bstride0;
	61	const char *bptr;
	62
9130521e	63	index_type count[GFC_MAX_DIMENSIONS];
9130521e	64	index_type extent[GFC_MAX_DIMENSIONS];
4ee9c684	65	index_type dim;
4ee9c684	66	index_type len;
4ee9c684	67	index_type n;
827aef63	68	index_type size;
5d04d450	69	index_type arraysize;
4ee9c684	70	int which;
	71	GFC_INTEGER_4 sh;
	72	GFC_INTEGER_4 delta;
	73
7b49b59f	74	/* The compiler cannot figure out that these are set, initialize
	75	them to avoid warnings. */
	76	len = 0;
	77	soffset = 0;
	78	roffset = 0;
	79
5d04d450	80	arraysize = size0 ((array_t *) array);
827aef63	81	size = GFC_DESCRIPTOR_SIZE(array);
827aef63	82
4ee9c684	83	if (pwhich)
	84	which = *pwhich - 1;
	85	else
	86	which = 0;
	87
553877d9	88	if (ret->base_addr == NULL)
71a8a4b3	89	{
	90	int i;
	91
af1e9051	92	ret->base_addr = xmallocarray (arraysize, size);
93830de1	93	ret->offset = 0;
71a8a4b3	94	ret->dtype = array->dtype;
	95	for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
	96	{
827aef63	97	index_type ub, str;
	98
	99	ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
71a8a4b3	100
71a8a4b3	101	if (i == 0)
827aef63	102	str = 1;
71a8a4b3	103	else
827aef63	104	str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
	105	* GFC_DESCRIPTOR_STRIDE(ret,i-1);
	106
	107	GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
	108
71a8a4b3	109	}
af1e9051	110	/* xmallocarray allocates a single byte for zero size. */
af1e9051	111	ret->base_addr = xmallocarray (arraysize, size);
5d04d450	112
71a8a4b3	113	}
5d04d450	114	else if (unlikely (compile_options.bounds_check))
	115	{
	116	bounds_equal_extents ((array_t ) ret, (array_t ) array,
	117	"return value", "EOSHIFT");
	118	}
	119
	120	if (unlikely (compile_options.bounds_check))
74a175c1	121	{
5d04d450	122	bounds_reduced_extents ((array_t ) h, (array_t ) array, which,
5d04d450	123	"SHIFT argument", "EOSHIFT");
74a175c1	124	}
71a8a4b3	125
5d04d450	126	if (arraysize == 0)
5d04d450	127	return;
4ee9c684	128
	129	extent[0] = 1;
	130	count[0] = 0;
4ee9c684	131	n = 0;
	132	for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
	133	{
	134	if (dim == which)
	135	{
827aef63	136	roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
4ee9c684	137	if (roffset == 0)
4ee9c684	138	roffset = size;
827aef63	139	soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
4ee9c684	140	if (soffset == 0)
4ee9c684	141	soffset = size;
827aef63	142	len = GFC_DESCRIPTOR_EXTENT(array,dim);
4ee9c684	143	}
	144	else
	145	{
	146	count[n] = 0;
827aef63	147	extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
	148	rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
	149	sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
4ee9c684	150
827aef63	151	hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
4ee9c684	152	if (bound)
827aef63	153	bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
4ee9c684	154	else
	155	bstride[n] = 0;
	156	n++;
	157	}
	158	}
	159	if (sstride[0] == 0)
	160	sstride[0] = size;
	161	if (rstride[0] == 0)
	162	rstride[0] = size;
	163	if (hstride[0] == 0)
	164	hstride[0] = 1;
	165	if (bound && bstride[0] == 0)
	166	bstride[0] = size;
	167
	168	dim = GFC_DESCRIPTOR_RANK (array);
	169	rstride0 = rstride[0];
	170	sstride0 = sstride[0];
	171	hstride0 = hstride[0];
	172	bstride0 = bstride[0];
553877d9	173	rptr = ret->base_addr;
	174	sptr = array->base_addr;
	175	hptr = h->base_addr;
4ee9c684	176	if (bound)
553877d9	177	bptr = bound->base_addr;
4ee9c684	178	else
1a9a4a12	179	bptr = NULL;
4ee9c684	180
	181	while (rptr)
	182	{
	183	/* Do the shift for this dimension. */
	184	sh = *hptr;
4eef4aad	185	if (( sh >= 0 ? sh : -sh ) > len)
	186	{
	187	delta = len;
	188	sh = len;
	189	}
	190	else
	191	delta = (sh >= 0) ? sh: -sh;
	192
4ee9c684	193	if (sh > 0)
	194	{
	195	src = &sptr[delta * soffset];
	196	dest = rptr;
	197	}
	198	else
	199	{
	200	src = sptr;
	201	dest = &rptr[delta * roffset];
	202	}
	203	for (n = 0; n < len - delta; n++)
	204	{
	205	memcpy (dest, src, size);
	206	dest += roffset;
	207	src += soffset;
	208	}
	209	if (sh < 0)
	210	dest = rptr;
	211	n = delta;
	212
1a9a4a12	213	if (bptr)
	214	while (n--)
	215	{
	216	memcpy (dest, bptr, size);
	217	dest += roffset;
	218	}
	219	else
	220	while (n--)
	221	{
329f13ad	222	index_type i;
	223
	224	if (filler_len == 1)
	225	memset (dest, filler[0], size);
	226	else
	227	for (i = 0; i < size; i += filler_len)
	228	memcpy (&dest[i], filler, filler_len);
	229
1a9a4a12	230	dest += roffset;
1a9a4a12	231	}
4ee9c684	232
	233	/* Advance to the next section. */
	234	rptr += rstride0;
	235	sptr += sstride0;
	236	hptr += hstride0;
	237	bptr += bstride0;
	238	count[0]++;
	239	n = 0;
	240	while (count[n] == extent[n])
	241	{
	242	/* When we get to the end of a dimension, reset it and increment
	243	the next dimension. */
	244	count[n] = 0;
	245	/* We could precalculate these products, but this is a less
e4f51eaa	246	frequently used path so probably not worth it. */
4ee9c684	247	rptr -= rstride[n] * extent[n];
	248	sptr -= sstride[n] * extent[n];
	249	hptr -= hstride[n] * extent[n];
	250	bptr -= bstride[n] * extent[n];
	251	n++;
	252	if (n >= dim - 1)
	253	{
	254	/* Break out of the loop. */
	255	rptr = NULL;
	256	break;
	257	}
	258	else
	259	{
	260	count[n]++;
	261	rptr += rstride[n];
	262	sptr += sstride[n];
	263	hptr += hstride[n];
	264	bptr += bstride[n];
	265	}
	266	}
	267	}
	268	}
1a9a4a12	269
b4cafd67	270	extern void eoshift3_4 (gfc_array_char * const restrict,
	271	const gfc_array_char * const restrict,
	272	const gfc_array_i4 * const restrict,
	273	const gfc_array_char * const restrict,
	274	const GFC_INTEGER_4 *);
1a9a4a12	275	export_proto(eoshift3_4);
	276
	277	void
b4cafd67	278	eoshift3_4 (gfc_array_char * const restrict ret,
	279	const gfc_array_char * const restrict array,
	280	const gfc_array_i4 * const restrict h,
	281	const gfc_array_char * const restrict bound,
	282	const GFC_INTEGER_4 * const restrict pwhich)
1a9a4a12	283	{
827aef63	284	eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
1a9a4a12	285	}
1a9a4a12	286
329f13ad	287
b4cafd67	288	extern void eoshift3_4_char (gfc_array_char * const restrict,
	289	GFC_INTEGER_4,
	290	const gfc_array_char * const restrict,
	291	const gfc_array_i4 * const restrict,
	292	const gfc_array_char * const restrict,
	293	const GFC_INTEGER_4 * const restrict,
	294	GFC_INTEGER_4, GFC_INTEGER_4);
1a9a4a12	295	export_proto(eoshift3_4_char);
	296
	297	void
b4cafd67	298	eoshift3_4_char (gfc_array_char * const restrict ret,
	299	GFC_INTEGER_4 ret_length __attribute__((unused)),
	300	const gfc_array_char * const restrict array,
	301	const gfc_array_i4 * const restrict h,
	302	const gfc_array_char * const restrict bound,
	303	const GFC_INTEGER_4 * const restrict pwhich,
827aef63	304	GFC_INTEGER_4 array_length __attribute__((unused)),
b4cafd67	305	GFC_INTEGER_4 bound_length __attribute__((unused)))
1a9a4a12	306	{
827aef63	307	eoshift3 (ret, array, h, bound, pwhich, " ", 1);
329f13ad	308	}
	309
	310
	311	extern void eoshift3_4_char4 (gfc_array_char * const restrict,
	312	GFC_INTEGER_4,
	313	const gfc_array_char * const restrict,
	314	const gfc_array_i4 * const restrict,
	315	const gfc_array_char * const restrict,
	316	const GFC_INTEGER_4 * const restrict,
	317	GFC_INTEGER_4, GFC_INTEGER_4);
	318	export_proto(eoshift3_4_char4);
	319
	320	void
	321	eoshift3_4_char4 (gfc_array_char * const restrict ret,
	322	GFC_INTEGER_4 ret_length __attribute__((unused)),
	323	const gfc_array_char * const restrict array,
	324	const gfc_array_i4 * const restrict h,
	325	const gfc_array_char * const restrict bound,
	326	const GFC_INTEGER_4 * const restrict pwhich,
827aef63	327	GFC_INTEGER_4 array_length __attribute__((unused)),
329f13ad	328	GFC_INTEGER_4 bound_length __attribute__((unused)))
	329	{
	330	static const gfc_char4_t space = (unsigned char) ' ';
827aef63	331	eoshift3 (ret, array, h, bound, pwhich,
329f13ad	332	(const char *) &space, sizeof (gfc_char4_t));
1a9a4a12	333	}
920e54ef	334
920e54ef	335	#endif