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

/* Implementation of the CSHIFT intrinsic
   Copyright (C) 2003-2022 Free Software Foundation, Inc.
   Contributed by Feng Wang <wf_cs@yahoo.com>

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.

Ligbfortran 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>


#if defined (HAVE_GFC_INTEGER_16)

static void
cshift1 (gfc_array_char * const restrict ret, 
	const gfc_array_char * const restrict array,
	const gfc_array_i16 * const restrict h, 
	const GFC_INTEGER_16 * const restrict pwhich)
{
  /* r.* indicates the return array.  */
  index_type rstride[GFC_MAX_DIMENSIONS];
  index_type rstride0;
  index_type roffset;
  char *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;
  /* 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;
  index_type arraysize;
  index_type size;
  index_type type_size;
  
  if (pwhich)
    which = *pwhich - 1;
  else
    which = 0;
 
  if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
    runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");

  size = GFC_DESCRIPTOR_SIZE(array);

  arraysize = size0 ((array_t *)array);

  if (ret->base_addr == NULL)
    {
      ret->base_addr = xmallocarray (arraysize, size);
      ret->offset = 0;
      GFC_DTYPE_COPY(ret,array);
      for (index_type 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);
        }
    }
  else if (unlikely (compile_options.bounds_check))
    {
      bounds_equal_extents ((array_t *) ret, (array_t *) array,
				 "return value", "CSHIFT");
    }

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

  if (arraysize == 0)
    return;

  /* See if we should dispatch to a helper function.  */

  type_size = GFC_DTYPE_TYPE_SIZE (array);

  switch (type_size)
  {
    case GFC_DTYPE_LOGICAL_1:
    case GFC_DTYPE_INTEGER_1:
      cshift1_16_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array,
      			h, pwhich);
      return;
 
    case GFC_DTYPE_LOGICAL_2:
    case GFC_DTYPE_INTEGER_2:
      cshift1_16_i2 ((gfc_array_i2 *)ret, (gfc_array_i2 *) array,
      			h, pwhich);
      return;
 
    case GFC_DTYPE_LOGICAL_4:
    case GFC_DTYPE_INTEGER_4:
      cshift1_16_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array,
      			h, pwhich);
      return;

    case GFC_DTYPE_LOGICAL_8:
    case GFC_DTYPE_INTEGER_8:
      cshift1_16_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array,
      			h, pwhich);
      return;

#if defined (HAVE_INTEGER_16)
    case GFC_DTYPE_LOGICAL_16:
    case GFC_DTYPE_INTEGER_16:
      cshift1_16_i16 ((gfc_array_i16 *)ret, (gfc_array_i16 *) array,
      			h, pwhich);
      return;
#endif

    case GFC_DTYPE_REAL_4:
      cshift1_16_r4 ((gfc_array_r4 *)ret, (gfc_array_r4 *) array,
      			h, pwhich);
      return;

    case GFC_DTYPE_REAL_8:
      cshift1_16_r8 ((gfc_array_r8 *)ret, (gfc_array_r8 *) array,
      			h, pwhich);
      return;

#if defined (HAVE_REAL_10)
    case GFC_DTYPE_REAL_10:
      cshift1_16_r10 ((gfc_array_r10 *)ret, (gfc_array_r10 *) array,
      			h, pwhich);
      return;
#endif

#if defined (HAVE_REAL_16)
    case GFC_DTYPE_REAL_16:
      cshift1_16_r16 ((gfc_array_r16 *)ret, (gfc_array_r16 *) array,
      			h, pwhich);
      return;
#endif

    case GFC_DTYPE_COMPLEX_4:
      cshift1_16_c4 ((gfc_array_c4 *)ret, (gfc_array_c4 *) array,
      			h, pwhich);
      return;

    case GFC_DTYPE_COMPLEX_8:
      cshift1_16_c8 ((gfc_array_c8 *)ret, (gfc_array_c8 *) array,
      			h, pwhich);
      return;

#if defined (HAVE_COMPLEX_10)
    case GFC_DTYPE_COMPLEX_10:
      cshift1_16_c10 ((gfc_array_c10 *)ret, (gfc_array_c10 *) array,
      			h, pwhich);
      return;
#endif

#if defined (HAVE_COMPLEX_16)
    case GFC_DTYPE_COMPLEX_16:
      cshift1_16_c16 ((gfc_array_c16 *)ret, (gfc_array_c16 *) array,
      			h, pwhich);
      return;
#endif

    default:
      break;
    
  }
  
  extent[0] = 1;
  count[0] = 0;
  n = 0;

  /* Initialized for avoiding compiler warnings.  */
  roffset = size;
  soffset = size;
  len = 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);
          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->base_addr;
  sptr = array->base_addr;
  hptr = h->base_addr;

  while (rptr)
    {
      /* Do the shift for this dimension.  */
      sh = *hptr;
      /* Normal case should be -len < sh < len; try to
         avoid the expensive remainder operation if possible.  */
      if (sh < 0)
        sh += len;
      if (unlikely (sh >= len || sh < 0))
        {
	  sh = sh % len;
	  if (sh < 0)
	    sh += len;
	}

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

      /* 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 cshift1_16 (gfc_array_char * const restrict, 
	const gfc_array_char * const restrict,
	const gfc_array_i16 * const restrict, 
	const GFC_INTEGER_16 * const restrict);
export_proto(cshift1_16);

void
cshift1_16 (gfc_array_char * const restrict ret,
	const gfc_array_char * const restrict array,
	const gfc_array_i16 * const restrict h, 
	const GFC_INTEGER_16 * const restrict pwhich)
{
  cshift1 (ret, array, h, pwhich);
}


void cshift1_16_char (gfc_array_char * const restrict ret, 
	GFC_INTEGER_4,
	const gfc_array_char * const restrict array,
	const gfc_array_i16 * const restrict h, 
	const GFC_INTEGER_16 * const restrict pwhich,
	GFC_INTEGER_4);
export_proto(cshift1_16_char);

void
cshift1_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 GFC_INTEGER_16 * const restrict pwhich,
	GFC_INTEGER_4 array_length __attribute__((unused)))
{
  cshift1 (ret, array, h, pwhich);
}


void cshift1_16_char4 (gfc_array_char * const restrict ret, 
	GFC_INTEGER_4,
	const gfc_array_char * const restrict array,
	const gfc_array_i16 * const restrict h, 
	const GFC_INTEGER_16 * const restrict pwhich,
	GFC_INTEGER_4);
export_proto(cshift1_16_char4);

void
cshift1_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 GFC_INTEGER_16 * const restrict pwhich,
	GFC_INTEGER_4 array_length __attribute__((unused)))
{
  cshift1 (ret, array, h, pwhich);
}

#endif
Commit	Line	Data
644cb69f	1	/* Implementation of the CSHIFT intrinsic
7adcbafe	2	Copyright (C) 2003-2022 Free Software Foundation, Inc.
644cb69f FXC	3	Contributed by Feng Wang <wf_cs@yahoo.com>
644cb69f FXC	4
21d1335b	5	This file is part of the GNU Fortran runtime library (libgfortran).
644cb69f FXC	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	Ligbfortran 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	27	#include <string.h>
36ae8a61	28
644cb69f FXC	29
	30	#if defined (HAVE_GFC_INTEGER_16)
	31
	32	static void
64acfd99 JB	33	cshift1 (gfc_array_char * const restrict ret,
	34	const gfc_array_char * const restrict array,
	35	const gfc_array_i16 * const restrict h,
dfb55fdc	36	const GFC_INTEGER_16 * const restrict pwhich)
644cb69f FXC	37	{
	38	/* r.* indicates the return array. */
	39	index_type rstride[GFC_MAX_DIMENSIONS];
	40	index_type rstride0;
	41	index_type roffset;
	42	char *rptr;
	43	char *dest;
	44	/* s.* indicates the source array. */
	45	index_type sstride[GFC_MAX_DIMENSIONS];
	46	index_type sstride0;
	47	index_type soffset;
	48	const char *sptr;
	49	const char *src;
80ee04b9	50	/* h.* indicates the shift array. */
644cb69f FXC	51	index_type hstride[GFC_MAX_DIMENSIONS];
	52	index_type hstride0;
	53	const GFC_INTEGER_16 *hptr;
	54
	55	index_type count[GFC_MAX_DIMENSIONS];
	56	index_type extent[GFC_MAX_DIMENSIONS];
	57	index_type dim;
	58	index_type len;
	59	index_type n;
	60	int which;
	61	GFC_INTEGER_16 sh;
c44109aa	62	index_type arraysize;
dfb55fdc	63	index_type size;
e56e3fda TK	64	index_type type_size;
e56e3fda TK	65
644cb69f FXC	66	if (pwhich)
	67	which = *pwhich - 1;
	68	else
	69	which = 0;
e56e3fda	70
644cb69f FXC	71	if (which < 0 \|\| (which + 1) > GFC_DESCRIPTOR_RANK (array))
	72	runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
	73
dfb55fdc TK	74	size = GFC_DESCRIPTOR_SIZE(array);
dfb55fdc TK	75
c44109aa TK	76	arraysize = size0 ((array_t *)array);
c44109aa TK	77
21d1335b	78	if (ret->base_addr == NULL)
644cb69f	79	{
92e6f3a4	80	ret->base_addr = xmallocarray (arraysize, size);
644cb69f	81	ret->offset = 0;
fa3c4d47	82	GFC_DTYPE_COPY(ret,array);
7a157266	83	for (index_type i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
644cb69f	84	{
dfb55fdc TK	85	index_type ub, str;
	86
	87	ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
644cb69f FXC	88
644cb69f FXC	89	if (i == 0)
dfb55fdc	90	str = 1;
644cb69f	91	else
dfb55fdc TK	92	str = GFC_DESCRIPTOR_EXTENT(ret,i-1) *
	93	GFC_DESCRIPTOR_STRIDE(ret,i-1);
	94
	95	GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
644cb69f FXC	96	}
644cb69f FXC	97	}
16bff921 TK	98	else if (unlikely (compile_options.bounds_check))
	99	{
	100	bounds_equal_extents ((array_t ) ret, (array_t ) array,
	101	"return value", "CSHIFT");
	102	}
	103
	104	if (unlikely (compile_options.bounds_check))
	105	{
	106	bounds_reduced_extents ((array_t ) h, (array_t ) array, which,
	107	"SHIFT argument", "CSHIFT");
	108	}
644cb69f	109
c44109aa TK	110	if (arraysize == 0)
	111	return;
	112
e56e3fda TK	113	/* See if we should dispatch to a helper function. */
	114
	115	type_size = GFC_DTYPE_TYPE_SIZE (array);
	116
	117	switch (type_size)
	118	{
	119	case GFC_DTYPE_LOGICAL_1:
	120	case GFC_DTYPE_INTEGER_1:
e56e3fda TK	121	cshift1_16_i1 ((gfc_array_i1 )ret, (gfc_array_i1 ) array,
	122	h, pwhich);
	123	return;
	124
	125	case GFC_DTYPE_LOGICAL_2:
	126	case GFC_DTYPE_INTEGER_2:
	127	cshift1_16_i2 ((gfc_array_i2 )ret, (gfc_array_i2 ) array,
	128	h, pwhich);
	129	return;
	130
	131	case GFC_DTYPE_LOGICAL_4:
	132	case GFC_DTYPE_INTEGER_4:
	133	cshift1_16_i4 ((gfc_array_i4 )ret, (gfc_array_i4 ) array,
	134	h, pwhich);
	135	return;
	136
	137	case GFC_DTYPE_LOGICAL_8:
	138	case GFC_DTYPE_INTEGER_8:
	139	cshift1_16_i8 ((gfc_array_i8 )ret, (gfc_array_i8 ) array,
	140	h, pwhich);
	141	return;
	142
	143	#if defined (HAVE_INTEGER_16)
	144	case GFC_DTYPE_LOGICAL_16:
	145	case GFC_DTYPE_INTEGER_16:
	146	cshift1_16_i16 ((gfc_array_i16 )ret, (gfc_array_i16 ) array,
	147	h, pwhich);
	148	return;
	149	#endif
	150
	151	case GFC_DTYPE_REAL_4:
	152	cshift1_16_r4 ((gfc_array_r4 )ret, (gfc_array_r4 ) array,
	153	h, pwhich);
	154	return;
	155
	156	case GFC_DTYPE_REAL_8:
	157	cshift1_16_r8 ((gfc_array_r8 )ret, (gfc_array_r8 ) array,
	158	h, pwhich);
	159	return;
	160
	161	#if defined (HAVE_REAL_10)
	162	case GFC_DTYPE_REAL_10:
	163	cshift1_16_r10 ((gfc_array_r10 )ret, (gfc_array_r10 ) array,
	164	h, pwhich);
	165	return;
	166	#endif
	167
	168	#if defined (HAVE_REAL_16)
	169	case GFC_DTYPE_REAL_16:
	170	cshift1_16_r16 ((gfc_array_r16 )ret, (gfc_array_r16 ) array,
	171	h, pwhich);
	172	return;
	173	#endif
	174
	175	case GFC_DTYPE_COMPLEX_4:
	176	cshift1_16_c4 ((gfc_array_c4 )ret, (gfc_array_c4 ) array,
	177	h, pwhich);
	178	return;
	179
	180	case GFC_DTYPE_COMPLEX_8:
	181	cshift1_16_c8 ((gfc_array_c8 )ret, (gfc_array_c8 ) array,
	182	h, pwhich);
	183	return;
	184
185	#if defined (HAVE_COMPLEX_10)
186	case GFC_DTYPE_COMPLEX_10:
187	cshift1_16_c10 ((gfc_array_c10 )ret, (gfc_array_c10 ) array,
188	h, pwhich);
189	return;
190	#endif
191
192	#if defined (HAVE_COMPLEX_16)
193	case GFC_DTYPE_COMPLEX_16:
194	cshift1_16_c16 ((gfc_array_c16 )ret, (gfc_array_c16 ) array,
195	h, pwhich);
196	return;
197	#endif
198
199	default:
200	break;
201
202	}
203
644cb69f FXC	204	extent[0] = 1;
	205	count[0] = 0;
	206	n = 0;
	207
	208	/* Initialized for avoiding compiler warnings. */
	209	roffset = size;
	210	soffset = size;
	211	len = 0;
	212
	213	for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
	214	{
	215	if (dim == which)
	216	{
dfb55fdc	217	roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
644cb69f FXC	218	if (roffset == 0)
644cb69f FXC	219	roffset = size;
dfb55fdc	220	soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
644cb69f FXC	221	if (soffset == 0)
644cb69f FXC	222	soffset = size;
dfb55fdc	223	len = GFC_DESCRIPTOR_EXTENT(array,dim);
644cb69f FXC	224	}
	225	else
	226	{
	227	count[n] = 0;
dfb55fdc TK	228	extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
	229	rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
	230	sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
644cb69f	231
dfb55fdc	232	hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
644cb69f FXC	233	n++;
	234	}
	235	}
	236	if (sstride[0] == 0)
	237	sstride[0] = size;
	238	if (rstride[0] == 0)
	239	rstride[0] = size;
	240	if (hstride[0] == 0)
	241	hstride[0] = 1;
	242
	243	dim = GFC_DESCRIPTOR_RANK (array);
	244	rstride0 = rstride[0];
	245	sstride0 = sstride[0];
	246	hstride0 = hstride[0];
21d1335b TB	247	rptr = ret->base_addr;
	248	sptr = array->base_addr;
	249	hptr = h->base_addr;
644cb69f FXC	250
	251	while (rptr)
	252	{
80ee04b9	253	/* Do the shift for this dimension. */
644cb69f	254	sh = *hptr;
e56e3fda TK	255	/* Normal case should be -len < sh < len; try to
e56e3fda TK	256	avoid the expensive remainder operation if possible. */
644cb69f FXC	257	if (sh < 0)
644cb69f FXC	258	sh += len;
e56e3fda TK	259	if (unlikely (sh >= len \|\| sh < 0))
	260	{
	261	sh = sh % len;
	262	if (sh < 0)
	263	sh += len;
	264	}
644cb69f FXC	265
	266	src = &sptr[sh * soffset];
	267	dest = rptr;
e56e3fda TK	268	if (soffset == size && roffset == size)
	269	{
	270	size_t len1 = sh * size;
	271	size_t len2 = (len - sh) * size;
	272	memcpy (rptr, sptr + len1, len2);
	273	memcpy (rptr + len2, sptr, len1);
	274	}
	275	else
644cb69f	276	{
e56e3fda TK	277	for (n = 0; n < len - sh; n++)
	278	{
	279	memcpy (dest, src, size);
	280	dest += roffset;
	281	src += soffset;
	282	}
	283	for (src = sptr, n = 0; n < sh; n++)
	284	{
	285	memcpy (dest, src, size);
	286	dest += roffset;
	287	src += soffset;
	288	}
	289	}
644cb69f FXC	290
	291	/* Advance to the next section. */
	292	rptr += rstride0;
	293	sptr += sstride0;
	294	hptr += hstride0;
	295	count[0]++;
	296	n = 0;
	297	while (count[n] == extent[n])
	298	{
	299	/* When we get to the end of a dimension, reset it and increment
	300	the next dimension. */
	301	count[n] = 0;
	302	/* We could precalculate these products, but this is a less
5d7adf7a	303	frequently used path so probably not worth it. */
644cb69f FXC	304	rptr -= rstride[n] * extent[n];
	305	sptr -= sstride[n] * extent[n];
	306	hptr -= hstride[n] * extent[n];
	307	n++;
	308	if (n >= dim - 1)
	309	{
	310	/* Break out of the loop. */
	311	rptr = NULL;
	312	break;
	313	}
	314	else
	315	{
	316	count[n]++;
	317	rptr += rstride[n];
	318	sptr += sstride[n];
	319	hptr += hstride[n];
	320	}
	321	}
	322	}
	323	}
	324
64acfd99 JB	325	void cshift1_16 (gfc_array_char * const restrict,
	326	const gfc_array_char * const restrict,
	327	const gfc_array_i16 * const restrict,
	328	const GFC_INTEGER_16 * const restrict);
644cb69f FXC	329	export_proto(cshift1_16);
	330
	331	void
64acfd99 JB	332	cshift1_16 (gfc_array_char * const restrict ret,
	333	const gfc_array_char * const restrict array,
	334	const gfc_array_i16 * const restrict h,
	335	const GFC_INTEGER_16 * const restrict pwhich)
644cb69f	336	{
dfb55fdc	337	cshift1 (ret, array, h, pwhich);
644cb69f FXC	338	}
644cb69f FXC	339
691da334	340
64acfd99 JB	341	void cshift1_16_char (gfc_array_char * const restrict ret,
	342	GFC_INTEGER_4,
	343	const gfc_array_char * const restrict array,
	344	const gfc_array_i16 * const restrict h,
	345	const GFC_INTEGER_16 * const restrict pwhich,
	346	GFC_INTEGER_4);
644cb69f FXC	347	export_proto(cshift1_16_char);
	348
	349	void
64acfd99 JB	350	cshift1_16_char (gfc_array_char * const restrict ret,
	351	GFC_INTEGER_4 ret_length __attribute__((unused)),
	352	const gfc_array_char * const restrict array,
	353	const gfc_array_i16 * const restrict h,
	354	const GFC_INTEGER_16 * const restrict pwhich,
dfb55fdc	355	GFC_INTEGER_4 array_length __attribute__((unused)))
644cb69f	356	{
dfb55fdc	357	cshift1 (ret, array, h, pwhich);
644cb69f FXC	358	}
644cb69f FXC	359
691da334 FXC	360
	361	void cshift1_16_char4 (gfc_array_char * const restrict ret,
	362	GFC_INTEGER_4,
	363	const gfc_array_char * const restrict array,
	364	const gfc_array_i16 * const restrict h,
	365	const GFC_INTEGER_16 * const restrict pwhich,
	366	GFC_INTEGER_4);
	367	export_proto(cshift1_16_char4);
	368
	369	void
	370	cshift1_16_char4 (gfc_array_char * const restrict ret,
	371	GFC_INTEGER_4 ret_length __attribute__((unused)),
	372	const gfc_array_char * const restrict array,
	373	const gfc_array_i16 * const restrict h,
	374	const GFC_INTEGER_16 * const restrict pwhich,
dfb55fdc	375	GFC_INTEGER_4 array_length __attribute__((unused)))
691da334	376	{
dfb55fdc	377	cshift1 (ret, array, h, pwhich);
691da334 FXC	378	}
691da334 FXC	379
644cb69f	380	#endif