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

/* Implementation of the RESHAPE intrinsic
   Copyright (C) 2002-2024 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"


#if defined (HAVE_GFC_COMPLEX_8)

typedef GFC_FULL_ARRAY_DESCRIPTOR(1, index_type) shape_type;


extern void reshape_c8 (gfc_array_c8 * const restrict, 
	gfc_array_c8 * const restrict, 
	shape_type * const restrict,
	gfc_array_c8 * const restrict, 
	shape_type * const restrict);
export_proto(reshape_c8);

void
reshape_c8 (gfc_array_c8 * const restrict ret, 
	gfc_array_c8 * const restrict source, 
	shape_type * const restrict shape,
	gfc_array_c8 * const restrict pad, 
	shape_type * const restrict order)
{
  /* r.* indicates the return array.  */
  index_type rcount[GFC_MAX_DIMENSIONS];
  index_type rextent[GFC_MAX_DIMENSIONS];
  index_type rstride[GFC_MAX_DIMENSIONS];
  index_type rstride0;
  index_type rdim;
  index_type rsize;
  index_type rs;
  index_type rex;
  GFC_COMPLEX_8 *rptr;
  /* s.* indicates the source array.  */
  index_type scount[GFC_MAX_DIMENSIONS];
  index_type sextent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type sstride0;
  index_type sdim;
  index_type ssize;
  const GFC_COMPLEX_8 *sptr;
  /* p.* indicates the pad array.  */
  index_type pcount[GFC_MAX_DIMENSIONS];
  index_type pextent[GFC_MAX_DIMENSIONS];
  index_type pstride[GFC_MAX_DIMENSIONS];
  index_type pdim;
  index_type psize;
  const GFC_COMPLEX_8 *pptr;

  const GFC_COMPLEX_8 *src;
  int sempty, pempty, shape_empty;
  index_type shape_data[GFC_MAX_DIMENSIONS];

  rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
  /* rdim is always > 0; this lets the compiler optimize more and
   avoids a potential warning.  */
  GFC_ASSERT(rdim>0);

  if (rdim != GFC_DESCRIPTOR_RANK(ret))
    runtime_error("rank of return array incorrect in RESHAPE intrinsic");

  shape_empty = 0;

  for (index_type n = 0; n < rdim; n++)
    {
      shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
      if (shape_data[n] <= 0)
      {
        shape_data[n] = 0;
	shape_empty = 1;
      }
    }

  if (ret->base_addr == NULL)
    {
      index_type alloc_size;

      rs = 1;
      for (index_type n = 0; n < rdim; n++)
	{
	  rex = shape_data[n];

	  GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);

	  rs *= rex;
	}
      ret->offset = 0;

      if (unlikely (rs < 1))
        alloc_size = 0;
      else
        alloc_size = rs;

      ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_8));
      ret->dtype.rank = rdim;
    }

  if (shape_empty)
    return;

  if (pad)
    {
      pdim = GFC_DESCRIPTOR_RANK (pad);
      psize = 1;
      pempty = 0;
      for (index_type n = 0; n < pdim; n++)
        {
          pcount[n] = 0;
          pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
          pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
          if (pextent[n] <= 0)
	    {
	      pempty = 1;
	      pextent[n] = 0;
	    }

          if (psize == pstride[n])
            psize *= pextent[n];
          else
            psize = 0;
        }
      pptr = pad->base_addr;
    }
  else
    {
      pdim = 0;
      psize = 1;
      pempty = 1;
      pptr = NULL;
    }

  if (unlikely (compile_options.bounds_check))
    {
      index_type ret_extent, source_extent;

      rs = 1;
      for (index_type n = 0; n < rdim; n++)
	{
	  rs *= shape_data[n];
	  ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
	  if (ret_extent != shape_data[n])
	    runtime_error("Incorrect extent in return value of RESHAPE"
			  " intrinsic in dimension %ld: is %ld,"
			  " should be %ld", (long int) n+1,
			  (long int) ret_extent, (long int) shape_data[n]);
	}

      source_extent = 1;
      sdim = GFC_DESCRIPTOR_RANK (source);
      for (index_type n = 0; n < sdim; n++)
	{
	  index_type se;
	  se = GFC_DESCRIPTOR_EXTENT(source,n);
	  source_extent *= se > 0 ? se : 0;
	}

      if (rs > source_extent && (!pad || pempty))
	runtime_error("Incorrect size in SOURCE argument to RESHAPE"
		      " intrinsic: is %ld, should be %ld",
		      (long int) source_extent, (long int) rs);

      if (order)
	{
	  int seen[GFC_MAX_DIMENSIONS];
	  index_type v;

	  for (index_type n = 0; n < rdim; n++)
	    seen[n] = 0;

	  for (index_type n = 0; n < rdim; n++)
	    {
	      v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;

	      if (v < 0 || v >= rdim)
		runtime_error("Value %ld out of range in ORDER argument"
			      " to RESHAPE intrinsic", (long int) v + 1);

	      if (seen[v] != 0)
		runtime_error("Duplicate value %ld in ORDER argument to"
			      " RESHAPE intrinsic", (long int) v + 1);
		
	      seen[v] = 1;
	    }
	}
    }

  rsize = 1;
  for (index_type n = 0; n < rdim; n++)
    {
      index_type dim;
      if (order)
        dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
      else
        dim = n;

      rcount[n] = 0;
      rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
      rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
      if (rextent[n] < 0)
        rextent[n] = 0;

      if (rextent[n] != shape_data[dim])
        runtime_error ("shape and target do not conform");

      if (rsize == rstride[n])
        rsize *= rextent[n];
      else
        rsize = 0;
      if (rextent[n] <= 0)
        return;
    }

  sdim = GFC_DESCRIPTOR_RANK (source);

  /* sdim is always > 0; this lets the compiler optimize more and
   avoids a warning.  */
  GFC_ASSERT(sdim>0);

  ssize = 1;
  sempty = 0;
  for (index_type n = 0; n < sdim; n++)
    {
      scount[n] = 0;
      sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
      sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
      if (sextent[n] <= 0)
	{
	  sempty = 1;
	  sextent[n] = 0;
	}

      if (ssize == sstride[n])
        ssize *= sextent[n];
      else
        ssize = 0;
    }

  if (rsize != 0 && ssize != 0 && psize != 0)
    {
      rsize *= sizeof (GFC_COMPLEX_8);
      ssize *= sizeof (GFC_COMPLEX_8);
      psize *= sizeof (GFC_COMPLEX_8);
      reshape_packed ((char *)ret->base_addr, rsize, (char *)source->base_addr,
		      ssize, pad ? (char *)pad->base_addr : NULL, psize);
      return;
    }
  rptr = ret->base_addr;
  src = sptr = source->base_addr;
  rstride0 = rstride[0];
  sstride0 = sstride[0];

  if (sempty && pempty)
    abort ();

  if (sempty)
    {
      /* Pretend we are using the pad array the first time around, too.  */
      src = pptr;
      sptr = pptr;
      sdim = pdim;
      for (index_type dim = 0; dim < pdim; dim++)
	{
	  scount[dim] = pcount[dim];
	  sextent[dim] = pextent[dim];
	  sstride[dim] = pstride[dim];
	  sstride0 = pstride[0];
	}
    }

  while (rptr)
    {
      /* Select between the source and pad arrays.  */
      *rptr = *src;
      /* Advance to the next element.  */
      rptr += rstride0;
      src += sstride0;
      rcount[0]++;
      scount[0]++;

      /* Advance to the next destination element.  */
      index_type n = 0;
      while (rcount[n] == rextent[n])
        {
          /* When we get to the end of a dimension, reset it and increment
             the next dimension.  */
          rcount[n] = 0;
          /* We could precalculate these products, but this is a less
             frequently used path so probably not worth it.  */
          rptr -= rstride[n] * rextent[n];
          n++;
          if (n == rdim)
            {
              /* Break out of the loop.  */
              rptr = NULL;
              break;
            }
          else
            {
              rcount[n]++;
              rptr += rstride[n];
            }
        }
      /* Advance to the next source element.  */
      n = 0;
      while (scount[n] == sextent[n])
        {
          /* When we get to the end of a dimension, reset it and increment
             the next dimension.  */
          scount[n] = 0;
          /* We could precalculate these products, but this is a less
             frequently used path so probably not worth it.  */
          src -= sstride[n] * sextent[n];
          n++;
          if (n == sdim)
            {
              if (sptr && pad)
                {
                  /* Switch to the pad array.  */
                  sptr = NULL;
                  sdim = pdim;
                  for (index_type dim = 0; dim < pdim; dim++)
                    {
                      scount[dim] = pcount[dim];
                      sextent[dim] = pextent[dim];
                      sstride[dim] = pstride[dim];
                      sstride0 = sstride[0];
                    }
                }
              /* We now start again from the beginning of the pad array.  */
              src = pptr;
              break;
            }
          else
            {
              scount[n]++;
              src += sstride[n];
            }
        }
    }
}

#endif
Commit	Line	Data
dfb55fdc	1	/* Implementation of the RESHAPE intrinsic
a945c346	2	Copyright (C) 2002-2024 Free Software Foundation, Inc.
8f4dc7af TK	3	Contributed by Paul Brook <paul@nowt.org>
8f4dc7af TK	4
21d1335b	5	This file is part of the GNU Fortran runtime library (libgfortran).
8f4dc7af TK	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.
8f4dc7af TK	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/>. */
8f4dc7af	25
36ae8a61	26	#include "libgfortran.h"
36ae8a61	27
8f4dc7af	28
644cb69f FXC	29	#if defined (HAVE_GFC_COMPLEX_8)
644cb69f FXC	30
e9bfdf18	31	typedef GFC_FULL_ARRAY_DESCRIPTOR(1, index_type) shape_type;
8f4dc7af	32
8f4dc7af	33
64acfd99 JB	34	extern void reshape_c8 (gfc_array_c8 * const restrict,
	35	gfc_array_c8 * const restrict,
	36	shape_type * const restrict,
	37	gfc_array_c8 * const restrict,
	38	shape_type * const restrict);
8f4dc7af TK	39	export_proto(reshape_c8);
	40
	41	void
64acfd99 JB	42	reshape_c8 (gfc_array_c8 * const restrict ret,
	43	gfc_array_c8 * const restrict source,
	44	shape_type * const restrict shape,
	45	gfc_array_c8 * const restrict pad,
	46	shape_type * const restrict order)
8f4dc7af TK	47	{
	48	/* r.* indicates the return array. */
	49	index_type rcount[GFC_MAX_DIMENSIONS];
	50	index_type rextent[GFC_MAX_DIMENSIONS];
	51	index_type rstride[GFC_MAX_DIMENSIONS];
	52	index_type rstride0;
	53	index_type rdim;
	54	index_type rsize;
	55	index_type rs;
	56	index_type rex;
	57	GFC_COMPLEX_8 *rptr;
	58	/* s.* indicates the source array. */
	59	index_type scount[GFC_MAX_DIMENSIONS];
	60	index_type sextent[GFC_MAX_DIMENSIONS];
	61	index_type sstride[GFC_MAX_DIMENSIONS];
	62	index_type sstride0;
	63	index_type sdim;
	64	index_type ssize;
	65	const GFC_COMPLEX_8 *sptr;
	66	/* p.* indicates the pad array. */
	67	index_type pcount[GFC_MAX_DIMENSIONS];
	68	index_type pextent[GFC_MAX_DIMENSIONS];
	69	index_type pstride[GFC_MAX_DIMENSIONS];
	70	index_type pdim;
	71	index_type psize;
	72	const GFC_COMPLEX_8 *pptr;
	73
	74	const GFC_COMPLEX_8 *src;
8c154b65 TK	75	int sempty, pempty, shape_empty;
	76	index_type shape_data[GFC_MAX_DIMENSIONS];
	77
dfb55fdc	78	rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
20305b50 TK	79	/* rdim is always > 0; this lets the compiler optimize more and
20305b50 TK	80	avoids a potential warning. */
dba937c3	81	GFC_ASSERT(rdim>0);
20305b50	82
8c154b65 TK	83	if (rdim != GFC_DESCRIPTOR_RANK(ret))
	84	runtime_error("rank of return array incorrect in RESHAPE intrinsic");
	85
	86	shape_empty = 0;
	87
7a157266	88	for (index_type n = 0; n < rdim; n++)
8c154b65	89	{
21d1335b	90	shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
8c154b65 TK	91	if (shape_data[n] <= 0)
	92	{
	93	shape_data[n] = 0;
	94	shape_empty = 1;
	95	}
	96	}
8f4dc7af	97
21d1335b	98	if (ret->base_addr == NULL)
8f4dc7af	99	{
19b76346 TK	100	index_type alloc_size;
19b76346 TK	101
8f4dc7af	102	rs = 1;
7a157266	103	for (index_type n = 0; n < rdim; n++)
8f4dc7af	104	{
8c154b65	105	rex = shape_data[n];
dfb55fdc TK	106
	107	GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
	108
8f4dc7af TK	109	rs *= rex;
8f4dc7af TK	110	}
efd4dc1a	111	ret->offset = 0;
19b76346 TK	112
19b76346 TK	113	if (unlikely (rs < 1))
92e6f3a4	114	alloc_size = 0;
19b76346	115	else
92e6f3a4	116	alloc_size = rs;
19b76346	117
92e6f3a4	118	ret->base_addr = xmallocarray (alloc_size, sizeof (GFC_COMPLEX_8));
ca708a2b	119	ret->dtype.rank = rdim;
8f4dc7af	120	}
8c154b65 TK	121
	122	if (shape_empty)
	123	return;
8f4dc7af	124
bd72cbc8 TK	125	if (pad)
	126	{
	127	pdim = GFC_DESCRIPTOR_RANK (pad);
	128	psize = 1;
	129	pempty = 0;
7a157266	130	for (index_type n = 0; n < pdim; n++)
bd72cbc8 TK	131	{
bd72cbc8 TK	132	pcount[n] = 0;
dfb55fdc TK	133	pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n);
dfb55fdc TK	134	pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n);
bd72cbc8 TK	135	if (pextent[n] <= 0)
	136	{
	137	pempty = 1;
	138	pextent[n] = 0;
	139	}
	140
	141	if (psize == pstride[n])
	142	psize *= pextent[n];
	143	else
	144	psize = 0;
	145	}
21d1335b	146	pptr = pad->base_addr;
bd72cbc8 TK	147	}
	148	else
	149	{
	150	pdim = 0;
	151	psize = 1;
	152	pempty = 1;
	153	pptr = NULL;
	154	}
	155
fd7f9754 TK	156	if (unlikely (compile_options.bounds_check))
fd7f9754 TK	157	{
21c74256 TK	158	index_type ret_extent, source_extent;
	159
	160	rs = 1;
7a157266	161	for (index_type n = 0; n < rdim; n++)
21c74256 TK	162	{
21c74256 TK	163	rs *= shape_data[n];
dfb55fdc	164	ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);
21c74256 TK	165	if (ret_extent != shape_data[n])
	166	runtime_error("Incorrect extent in return value of RESHAPE"
	167	" intrinsic in dimension %ld: is %ld,"
	168	" should be %ld", (long int) n+1,
	169	(long int) ret_extent, (long int) shape_data[n]);
	170	}
	171
a388c779 TK	172	source_extent = 1;
a388c779 TK	173	sdim = GFC_DESCRIPTOR_RANK (source);
7a157266	174	for (index_type n = 0; n < sdim; n++)
a388c779 TK	175	{
a388c779 TK	176	index_type se;
dfb55fdc	177	se = GFC_DESCRIPTOR_EXTENT(source,n);
a388c779 TK	178	source_extent *= se > 0 ? se : 0;
a388c779 TK	179	}
21c74256	180
bd72cbc8	181	if (rs > source_extent && (!pad \|\| pempty))
21c74256 TK	182	runtime_error("Incorrect size in SOURCE argument to RESHAPE"
	183	" intrinsic: is %ld, should be %ld",
	184	(long int) source_extent, (long int) rs);
	185
fd7f9754 TK	186	if (order)
	187	{
	188	int seen[GFC_MAX_DIMENSIONS];
	189	index_type v;
	190
7a157266	191	for (index_type n = 0; n < rdim; n++)
fd7f9754 TK	192	seen[n] = 0;
fd7f9754 TK	193
7a157266	194	for (index_type n = 0; n < rdim; n++)
fd7f9754	195	{
21d1335b	196	v = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
fd7f9754 TK	197
	198	if (v < 0 \|\| v >= rdim)
	199	runtime_error("Value %ld out of range in ORDER argument"
	200	" to RESHAPE intrinsic", (long int) v + 1);
	201
	202	if (seen[v] != 0)
	203	runtime_error("Duplicate value %ld in ORDER argument to"
	204	" RESHAPE intrinsic", (long int) v + 1);
	205
	206	seen[v] = 1;
	207	}
	208	}
	209	}
	210
8f4dc7af	211	rsize = 1;
7a157266	212	for (index_type n = 0; n < rdim; n++)
8f4dc7af	213	{
7a157266	214	index_type dim;
8f4dc7af	215	if (order)
21d1335b	216	dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
8f4dc7af TK	217	else
	218	dim = n;
	219
	220	rcount[n] = 0;
dfb55fdc TK	221	rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
dfb55fdc TK	222	rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
8c154b65	223	if (rextent[n] < 0)
e94471ba	224	rextent[n] = 0;
8f4dc7af	225
8c154b65	226	if (rextent[n] != shape_data[dim])
8f4dc7af TK	227	runtime_error ("shape and target do not conform");
	228
	229	if (rsize == rstride[n])
	230	rsize *= rextent[n];
	231	else
	232	rsize = 0;
	233	if (rextent[n] <= 0)
	234	return;
	235	}
	236
	237	sdim = GFC_DESCRIPTOR_RANK (source);
20305b50 TK	238
	239	/* sdim is always > 0; this lets the compiler optimize more and
	240	avoids a warning. */
	241	GFC_ASSERT(sdim>0);
	242
8f4dc7af	243	ssize = 1;
47c07d96	244	sempty = 0;
7a157266	245	for (index_type n = 0; n < sdim; n++)
8f4dc7af TK	246	{
8f4dc7af TK	247	scount[n] = 0;
dfb55fdc TK	248	sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
dfb55fdc TK	249	sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
8f4dc7af	250	if (sextent[n] <= 0)
47c07d96 FXC	251	{
	252	sempty = 1;
	253	sextent[n] = 0;
	254	}
8f4dc7af TK	255
	256	if (ssize == sstride[n])
	257	ssize *= sextent[n];
	258	else
	259	ssize = 0;
	260	}
	261
8f4dc7af TK	262	if (rsize != 0 && ssize != 0 && psize != 0)
8f4dc7af TK	263	{
92f5e87c TK	264	rsize *= sizeof (GFC_COMPLEX_8);
	265	ssize *= sizeof (GFC_COMPLEX_8);
	266	psize *= sizeof (GFC_COMPLEX_8);
21d1335b TB	267	reshape_packed ((char )ret->base_addr, rsize, (char )source->base_addr,
21d1335b TB	268	ssize, pad ? (char *)pad->base_addr : NULL, psize);
8f4dc7af TK	269	return;
8f4dc7af TK	270	}
21d1335b TB	271	rptr = ret->base_addr;
21d1335b TB	272	src = sptr = source->base_addr;
8f4dc7af TK	273	rstride0 = rstride[0];
	274	sstride0 = sstride[0];
	275
47c07d96 FXC	276	if (sempty && pempty)
	277	abort ();
	278
	279	if (sempty)
	280	{
042fed79	281	/* Pretend we are using the pad array the first time around, too. */
47c07d96	282	src = pptr;
042fed79	283	sptr = pptr;
47c07d96	284	sdim = pdim;
7a157266	285	for (index_type dim = 0; dim < pdim; dim++)
47c07d96 FXC	286	{
	287	scount[dim] = pcount[dim];
	288	sextent[dim] = pextent[dim];
	289	sstride[dim] = pstride[dim];
042fed79	290	sstride0 = pstride[0];
47c07d96 FXC	291	}
	292	}
	293
8f4dc7af TK	294	while (rptr)
	295	{
	296	/* Select between the source and pad arrays. */
	297	rptr = src;
	298	/* Advance to the next element. */
	299	rptr += rstride0;
	300	src += sstride0;
	301	rcount[0]++;
	302	scount[0]++;
47c07d96	303
8f4dc7af	304	/* Advance to the next destination element. */
7a157266	305	index_type n = 0;
8f4dc7af TK	306	while (rcount[n] == rextent[n])
	307	{
	308	/* When we get to the end of a dimension, reset it and increment
	309	the next dimension. */
	310	rcount[n] = 0;
	311	/* We could precalculate these products, but this is a less
5d7adf7a	312	frequently used path so probably not worth it. */
8f4dc7af TK	313	rptr -= rstride[n] * rextent[n];
	314	n++;
	315	if (n == rdim)
	316	{
	317	/* Break out of the loop. */
	318	rptr = NULL;
	319	break;
	320	}
	321	else
	322	{
	323	rcount[n]++;
	324	rptr += rstride[n];
	325	}
	326	}
	327	/* Advance to the next source element. */
	328	n = 0;
	329	while (scount[n] == sextent[n])
	330	{
	331	/* When we get to the end of a dimension, reset it and increment
	332	the next dimension. */
	333	scount[n] = 0;
	334	/* We could precalculate these products, but this is a less
5d7adf7a	335	frequently used path so probably not worth it. */
8f4dc7af TK	336	src -= sstride[n] * sextent[n];
	337	n++;
	338	if (n == sdim)
	339	{
	340	if (sptr && pad)
	341	{
	342	/* Switch to the pad array. */
	343	sptr = NULL;
	344	sdim = pdim;
7a157266	345	for (index_type dim = 0; dim < pdim; dim++)
8f4dc7af TK	346	{
	347	scount[dim] = pcount[dim];
	348	sextent[dim] = pextent[dim];
	349	sstride[dim] = pstride[dim];
	350	sstride0 = sstride[0];
	351	}
	352	}
	353	/* We now start again from the beginning of the pad array. */
	354	src = pptr;
	355	break;
	356	}
	357	else
	358	{
	359	scount[n]++;
	360	src += sstride[n];
	361	}
	362	}
	363	}
	364	}
644cb69f FXC	365
644cb69f FXC	366	#endif