[thirdparty/gcc.git] / libgfortran / intrinsics / eoshift0.c

/* Generic implementation of the EOSHIFT intrinsic
   Copyright (C) 2002-2022 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 <string.h>


static void
eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
	  index_type shift, const char * pbound, int which, 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 * restrict rptr;
  char *dest;
  /* s.* indicates the source array.  */
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type sstride0;
  index_type soffset;
  const char *sptr;
  const char *src;

  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dim;
  index_type len;
  index_type n;
  index_type arraysize;
  bool do_blocked;
  
  /* 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);

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

      ret->offset = 0;
      GFC_DTYPE_COPY(ret,array);
      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 (arraysize == 0)
    return;

  which = which - 1;

  extent[0] = 1;
  count[0] = 0;
  sstride[0] = -1;
  rstride[0] = -1;

  if (which > 0)
    {
      /* Test if both ret and array are contiguous.  */
      index_type r_ex, a_ex;
      r_ex = 1;
      a_ex = 1;
      do_blocked = true;
      dim = GFC_DESCRIPTOR_RANK (array);
      for (n = 0; n < dim; n ++)
	{
	  index_type rs, as;
	  rs = GFC_DESCRIPTOR_STRIDE (ret, n);
	  if (rs != r_ex)
	    {
	      do_blocked = false;
	      break;
	    }
	  as = GFC_DESCRIPTOR_STRIDE (array, n);
	  if (as != a_ex)
	    {
	      do_blocked = false;
	      break;
	    }
	  r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
	  a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
	}
    }
  else
    do_blocked = false;

  n = 0;

  if (do_blocked)
    {
      /* For contiguous arrays, use the relationship that

         dimension(n1,n2,n3) :: a, b
	 b = eoshift(a,sh,3)

         can be dealt with as if

	 dimension(n1*n2*n3) :: an, bn
	 bn = eoshift(a,sh*n1*n2,1)

	 so a block move can be used for dim>1.  */
      len = GFC_DESCRIPTOR_STRIDE(array, which)
	* GFC_DESCRIPTOR_EXTENT(array, which);
      shift *= GFC_DESCRIPTOR_STRIDE(array, which);
      roffset = size;
      soffset = size;
      for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
	{
	  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);
	  n++;
	}
      count[n] = 0;
      dim = GFC_DESCRIPTOR_RANK (array) - which;
    }
  else
    {
      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);
	      n++;
	    }
	}
      dim = GFC_DESCRIPTOR_RANK (array);
    }

  if ((shift >= 0 ? shift : -shift) > len)
    {
      shift = len;
      len = 0;
    }
  else
    {
      if (shift > 0)
	len = len - shift;
      else
	len = len + shift;
    }

  rstride0 = rstride[0];
  sstride0 = sstride[0];
  rptr = ret->base_addr;
  sptr = array->base_addr;

  while (rptr)
    {
      /* Do the shift for this dimension.  */
      if (shift > 0)
        {
          src = &sptr[shift * soffset];
          dest = rptr;
        }
      else
        {
          src = sptr;
          dest = &rptr[-shift * roffset];
        }
      /* If the elements are contiguous, perform a single block move.  */

      if (soffset == size && roffset == size)
	{
	  size_t chunk = size * len;
	  memcpy (dest, src, chunk);
	  dest += chunk;
	}
      else
	{
	  for (n = 0; n < len; n++)
	    {
	      memcpy (dest, src, size);
	      dest += roffset;
	      src += soffset;
	    }
	}
      if (shift >= 0)
        {
          n = shift;
        }
      else
        {
          dest = rptr;
          n = -shift;
        }

      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;
      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];
          n++;
          if (n >= dim - 1)
            {
              /* Break out of the loop.  */
              rptr = NULL;
              break;
            }
          else
            {
              count[n]++;
              rptr += rstride[n];
              sptr += sstride[n];
            }
        }
    }
}


#define DEFINE_EOSHIFT(N)						      \
  extern void eoshift0_##N (gfc_array_char *, const gfc_array_char *,	      \
			    const GFC_INTEGER_##N *, const char *,	      \
			    const GFC_INTEGER_##N *);			      \
  export_proto(eoshift0_##N);						      \
									      \
  void									      \
  eoshift0_##N (gfc_array_char *ret, const gfc_array_char *array,	      \
		const GFC_INTEGER_##N *pshift, const char *pbound,	      \
		const GFC_INTEGER_##N *pdim)				      \
  {									      \
    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
	      GFC_DESCRIPTOR_SIZE (array), "\0", 1);			      \
  }									      \
									      \
  extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4,	      \
				   const gfc_array_char *,		      \
				   const GFC_INTEGER_##N *, const char *,     \
				   const GFC_INTEGER_##N *, GFC_INTEGER_4,    \
				   GFC_INTEGER_4);			      \
  export_proto(eoshift0_##N##_char);					      \
									      \
  void									      \
  eoshift0_##N##_char (gfc_array_char *ret,				      \
		       GFC_INTEGER_4 ret_length __attribute__((unused)),      \
		       const gfc_array_char *array,			      \
		       const GFC_INTEGER_##N *pshift,			      \
		       const char *pbound,				      \
		       const GFC_INTEGER_##N *pdim,			      \
		       GFC_INTEGER_4 array_length,			      \
		       GFC_INTEGER_4 bound_length __attribute__((unused)))    \
  {									      \
    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
	      array_length, " ", 1);					      \
  }									      \
									      \
  extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4,	      \
				    const gfc_array_char *,		      \
				    const GFC_INTEGER_##N *, const char *,    \
				    const GFC_INTEGER_##N *, GFC_INTEGER_4,   \
				    GFC_INTEGER_4);			      \
  export_proto(eoshift0_##N##_char4);					      \
									      \
  void									      \
  eoshift0_##N##_char4 (gfc_array_char *ret,				      \
			GFC_INTEGER_4 ret_length __attribute__((unused)),     \
			const gfc_array_char *array,			      \
			const GFC_INTEGER_##N *pshift,			      \
			const char *pbound,				      \
			const GFC_INTEGER_##N *pdim,			      \
			GFC_INTEGER_4 array_length,			      \
			GFC_INTEGER_4 bound_length __attribute__((unused)))   \
  {									      \
    static const gfc_char4_t space = (unsigned char) ' ';		      \
    eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1,		      \
	      array_length * sizeof (gfc_char4_t), (const char *) &space,     \
	      sizeof (gfc_char4_t));					      \
  }

DEFINE_EOSHIFT (1);
DEFINE_EOSHIFT (2);
DEFINE_EOSHIFT (4);
DEFINE_EOSHIFT (8);
#ifdef HAVE_GFC_INTEGER_16
DEFINE_EOSHIFT (16);
#endif
Commit	Line	Data
883c9d4d	1	/* Generic implementation of the EOSHIFT intrinsic
7adcbafe	2	Copyright (C) 2002-2022 Free Software Foundation, Inc.
6de9cd9a DN	3	Contributed by Paul Brook <paul@nowt.org>
6de9cd9a DN	4
21d1335b	5	This file is part of the GNU Fortran runtime library (libgfortran).
6de9cd9a	6
57dea9f6 TM	7	Libgfortran is free software; you can redistribute it and/or
57dea9f6 TM	8	modify it under the terms of the GNU General Public
6de9cd9a	9	License as published by the Free Software Foundation; either
748086b7	10	version 3 of the License, or (at your option) any later version.
57dea9f6 TM	11
57dea9f6 TM	12	Libgfortran is distributed in the hope that it will be useful,
6de9cd9a DN	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
6de9cd9a DN	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6	15	GNU General Public License for more details.
6de9cd9a	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/>. */
6de9cd9a	25
36ae8a61	26	#include "libgfortran.h"
6de9cd9a	27	#include <string.h>
6de9cd9a	28
6de9cd9a DN	29
6de9cd9a DN	30	static void
7f68c75f	31	eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
a97ae559	32	index_type shift, const char * pbound, int which, index_type size,
691da334	33	const char *filler, index_type filler_len)
6de9cd9a DN	34	{
6de9cd9a DN	35	/* r.* indicates the return array. */
e33e218b	36	index_type rstride[GFC_MAX_DIMENSIONS];
6de9cd9a DN	37	index_type rstride0;
6de9cd9a DN	38	index_type roffset;
5863aacf	39	char * restrict rptr;
6de9cd9a DN	40	char *dest;
6de9cd9a DN	41	/* s.* indicates the source array. */
e33e218b	42	index_type sstride[GFC_MAX_DIMENSIONS];
6de9cd9a DN	43	index_type sstride0;
	44	index_type soffset;
	45	const char *sptr;
	46	const char *src;
	47
e33e218b TK	48	index_type count[GFC_MAX_DIMENSIONS];
e33e218b TK	49	index_type extent[GFC_MAX_DIMENSIONS];
6de9cd9a	50	index_type dim;
6de9cd9a DN	51	index_type len;
6de9cd9a DN	52	index_type n;
16bff921	53	index_type arraysize;
b677e2f6 TK	54	bool do_blocked;
b677e2f6 TK	55
7672ae20 AJ	56	/* The compiler cannot figure out that these are set, initialize
	57	them to avoid warnings. */
	58	len = 0;
	59	soffset = 0;
	60	roffset = 0;
	61
16bff921 TK	62	arraysize = size0 ((array_t *) array);
16bff921 TK	63
21d1335b	64	if (ret->base_addr == NULL)
883c9d4d VL	65	{
	66	int i;
	67
efd4dc1a	68	ret->offset = 0;
fa3c4d47	69	GFC_DTYPE_COPY(ret,array);
883c9d4d VL	70	for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
883c9d4d VL	71	{
dfb55fdc TK	72	index_type ub, str;
	73
	74	ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
883c9d4d VL	75
883c9d4d VL	76	if (i == 0)
dfb55fdc	77	str = 1;
883c9d4d	78	else
dfb55fdc TK	79	str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
	80	* GFC_DESCRIPTOR_STRIDE(ret,i-1);
	81
	82	GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
	83
883c9d4d	84	}
16bff921	85
92e6f3a4 JB	86	/* xmallocarray allocates a single byte for zero size. */
92e6f3a4 JB	87	ret->base_addr = xmallocarray (arraysize, size);
883c9d4d	88	}
16bff921	89	else if (unlikely (compile_options.bounds_check))
c44109aa	90	{
16bff921 TK	91	bounds_equal_extents ((array_t ) ret, (array_t ) array,
16bff921 TK	92	"return value", "EOSHIFT");
c44109aa	93	}
883c9d4d	94
16bff921 TK	95	if (arraysize == 0)
	96	return;
	97
6de9cd9a DN	98	which = which - 1;
	99
	100	extent[0] = 1;
	101	count[0] = 0;
1f801ab7 TB	102	sstride[0] = -1;
1f801ab7 TB	103	rstride[0] = -1;
b677e2f6 TK	104
b677e2f6 TK	105	if (which > 0)
6de9cd9a	106	{
b677e2f6	107	/* Test if both ret and array are contiguous. */
9cf7bfd9	108	index_type r_ex, a_ex;
b677e2f6 TK	109	r_ex = 1;
	110	a_ex = 1;
	111	do_blocked = true;
	112	dim = GFC_DESCRIPTOR_RANK (array);
	113	for (n = 0; n < dim; n ++)
	114	{
	115	index_type rs, as;
	116	rs = GFC_DESCRIPTOR_STRIDE (ret, n);
	117	if (rs != r_ex)
	118	{
	119	do_blocked = false;
	120	break;
	121	}
	122	as = GFC_DESCRIPTOR_STRIDE (array, n);
	123	if (as != a_ex)
	124	{
	125	do_blocked = false;
	126	break;
	127	}
	128	r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
	129	a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
	130	}
6de9cd9a	131	}
b677e2f6 TK	132	else
b677e2f6 TK	133	do_blocked = false;
6de9cd9a	134
b677e2f6 TK	135	n = 0;
	136
	137	if (do_blocked)
	138	{
	139	/* For contiguous arrays, use the relationship that
	140
	141	dimension(n1,n2,n3) :: a, b
	142	b = eoshift(a,sh,3)
	143
	144	can be dealt with as if
	145
	146	dimension(n1n2n3) :: an, bn
	147	bn = eoshift(a,shn1n2,1)
	148
	149	so a block move can be used for dim>1. */
	150	len = GFC_DESCRIPTOR_STRIDE(array, which)
	151	* GFC_DESCRIPTOR_EXTENT(array, which);
	152	shift *= GFC_DESCRIPTOR_STRIDE(array, which);
	153	roffset = size;
	154	soffset = size;
	155	for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
	156	{
	157	count[n] = 0;
	158	extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
	159	rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
	160	sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
	161	n++;
	162	}
	163	count[n] = 0;
	164	dim = GFC_DESCRIPTOR_RANK (array) - which;
	165	}
	166	else
	167	{
	168	for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
	169	{
	170	if (dim == which)
	171	{
	172	roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
	173	if (roffset == 0)
	174	roffset = size;
	175	soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
	176	if (soffset == 0)
	177	soffset = size;
	178	len = GFC_DESCRIPTOR_EXTENT(array,dim);
	179	}
	180	else
	181	{
	182	count[n] = 0;
	183	extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
	184	rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
	185	sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
	186	n++;
	187	}
	188	}
	189	dim = GFC_DESCRIPTOR_RANK (array);
	190	}
47b3a403 TK	191
	192	if ((shift >= 0 ? shift : -shift) > len)
	193	{
	194	shift = len;
	195	len = 0;
	196	}
6de9cd9a	197	else
47b3a403 TK	198	{
	199	if (shift > 0)
	200	len = len - shift;
	201	else
	202	len = len + shift;
	203	}
6de9cd9a	204
b677e2f6 TK	205	rstride0 = rstride[0];
	206	sstride0 = sstride[0];
	207	rptr = ret->base_addr;
	208	sptr = array->base_addr;
	209
6de9cd9a DN	210	while (rptr)
	211	{
	212	/* Do the shift for this dimension. */
	213	if (shift > 0)
	214	{
	215	src = &sptr[shift * soffset];
	216	dest = rptr;
	217	}
	218	else
	219	{
	220	src = sptr;
	221	dest = &rptr[-shift * roffset];
	222	}
b677e2f6 TK	223	/* If the elements are contiguous, perform a single block move. */
	224
	225	if (soffset == size && roffset == size)
	226	{
	227	size_t chunk = size * len;
	228	memcpy (dest, src, chunk);
	229	dest += chunk;
	230	}
	231	else
	232	{
	233	for (n = 0; n < len; n++)
	234	{
	235	memcpy (dest, src, size);
	236	dest += roffset;
	237	src += soffset;
	238	}
	239	}
6de9cd9a DN	240	if (shift >= 0)
	241	{
	242	n = shift;
	243	}
	244	else
	245	{
	246	dest = rptr;
	247	n = -shift;
	248	}
	249
7823229b RS	250	if (pbound)
	251	while (n--)
	252	{
	253	memcpy (dest, pbound, size);
	254	dest += roffset;
	255	}
	256	else
	257	while (n--)
	258	{
691da334 FXC	259	index_type i;
	260
	261	if (filler_len == 1)
	262	memset (dest, filler[0], size);
	263	else
	264	for (i = 0; i < size ; i += filler_len)
	265	memcpy (&dest[i], filler, filler_len);
	266
7823229b RS	267	dest += roffset;
7823229b RS	268	}
6de9cd9a DN	269
	270	/* Advance to the next section. */
	271	rptr += rstride0;
	272	sptr += sstride0;
	273	count[0]++;
	274	n = 0;
	275	while (count[n] == extent[n])
	276	{
	277	/* When we get to the end of a dimension, reset it and increment
	278	the next dimension. */
	279	count[n] = 0;
	280	/* We could precalculate these products, but this is a less
8b6dba81	281	frequently used path so probably not worth it. */
6de9cd9a DN	282	rptr -= rstride[n] * extent[n];
	283	sptr -= sstride[n] * extent[n];
	284	n++;
	285	if (n >= dim - 1)
	286	{
	287	/* Break out of the loop. */
	288	rptr = NULL;
	289	break;
	290	}
	291	else
	292	{
	293	count[n]++;
	294	rptr += rstride[n];
	295	sptr += sstride[n];
	296	}
	297	}
	298	}
	299	}
	300
985791f6	301
7823229b RS	302	#define DEFINE_EOSHIFT(N) \
	303	extern void eoshift0_##N (gfc_array_char , const gfc_array_char , \
	304	const GFC_INTEGER_##N , const char , \
	305	const GFC_INTEGER_##N *); \
	306	export_proto(eoshift0_##N); \
	307	\
	308	void \
	309	eoshift0_##N (gfc_array_char ret, const gfc_array_char array, \
	310	const GFC_INTEGER_##N pshift, const char pbound, \
	311	const GFC_INTEGER_##N *pdim) \
	312	{ \
	313	eoshift0 (ret, array, pshift, pbound, pdim ? pdim : 1, \
691da334	314	GFC_DESCRIPTOR_SIZE (array), "\0", 1); \
7823229b RS	315	} \
	316	\
	317	extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \
	318	const gfc_array_char *, \
	319	const GFC_INTEGER_##N , const char , \
	320	const GFC_INTEGER_##N *, GFC_INTEGER_4, \
	321	GFC_INTEGER_4); \
	322	export_proto(eoshift0_##N##_char); \
	323	\
	324	void \
	325	eoshift0_##N##_char (gfc_array_char *ret, \
	326	GFC_INTEGER_4 ret_length __attribute__((unused)), \
	327	const gfc_array_char *array, \
	328	const GFC_INTEGER_##N *pshift, \
	329	const char *pbound, \
	330	const GFC_INTEGER_##N *pdim, \
	331	GFC_INTEGER_4 array_length, \
	332	GFC_INTEGER_4 bound_length __attribute__((unused))) \
	333	{ \
	334	eoshift0 (ret, array, pshift, pbound, pdim ? pdim : 1, \
691da334 FXC	335	array_length, " ", 1); \
	336	} \
	337	\
	338	extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \
	339	const gfc_array_char *, \
	340	const GFC_INTEGER_##N , const char , \
	341	const GFC_INTEGER_##N *, GFC_INTEGER_4, \
	342	GFC_INTEGER_4); \
	343	export_proto(eoshift0_##N##_char4); \
	344	\
	345	void \
	346	eoshift0_##N##_char4 (gfc_array_char *ret, \
	347	GFC_INTEGER_4 ret_length __attribute__((unused)), \
	348	const gfc_array_char *array, \
	349	const GFC_INTEGER_##N *pshift, \
	350	const char *pbound, \
	351	const GFC_INTEGER_##N *pdim, \
	352	GFC_INTEGER_4 array_length, \
	353	GFC_INTEGER_4 bound_length __attribute__((unused))) \
	354	{ \
	355	static const gfc_char4_t space = (unsigned char) ' '; \
	356	eoshift0 (ret, array, pshift, pbound, pdim ? pdim : 1, \
	357	array_length * sizeof (gfc_char4_t), (const char *) &space, \
	358	sizeof (gfc_char4_t)); \
7823229b RS	359	}
	360
	361	DEFINE_EOSHIFT (1);
	362	DEFINE_EOSHIFT (2);
	363	DEFINE_EOSHIFT (4);
	364	DEFINE_EOSHIFT (8);
143350a8 TK	365	#ifdef HAVE_GFC_INTEGER_16
	366	DEFINE_EOSHIFT (16);
	367	#endif