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

/* Implementation of the RESHAPE 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>


#if defined (HAVE_GFC_INTEGER_4)

typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;


extern void reshape_4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, 
	shape_type * const restrict,
	gfc_array_i4 * const restrict, 
	shape_type * const restrict);
export_proto(reshape_4);

void
reshape_4 (gfc_array_i4 * const restrict ret, 
	gfc_array_i4 * const restrict source, 
	shape_type * const restrict shape,
	gfc_array_i4 * 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_INTEGER_4 *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_INTEGER_4 *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_INTEGER_4 *pptr;

  const GFC_INTEGER_4 *src;
  int n;
  int dim;
  int sempty, pempty, shape_empty;
  index_type shape_data[GFC_MAX_DIMENSIONS];

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

  shape_empty = 0;

  for (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 (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_INTEGER_4));
      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
    }

  if (shape_empty)
    return;

  if (pad)
    {
      pdim = GFC_DESCRIPTOR_RANK (pad);
      psize = 1;
      pempty = 0;
      for (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 (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 (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 (n = 0; n < rdim; n++)
	    seen[n] = 0;

	  for (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 (n = 0; n < rdim; n++)
    {
      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);
  ssize = 1;
  sempty = 0;
  for (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_INTEGER_4);
      ssize *= sizeof (GFC_INTEGER_4);
      psize *= sizeof (GFC_INTEGER_4);
      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 (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.  */
      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 (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
818ab71a	2	Copyright (C) 2002-2016 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 DN	27	#include <stdlib.h>
6de9cd9a DN	28	#include <assert.h>
36ae8a61	29
6de9cd9a	30
644cb69f FXC	31	#if defined (HAVE_GFC_INTEGER_4)
644cb69f FXC	32
6de9cd9a DN	33	typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
6de9cd9a DN	34
7d7b8bfe	35
64acfd99 JB	36	extern void reshape_4 (gfc_array_i4 * const restrict,
	37	gfc_array_i4 * const restrict,
	38	shape_type * const restrict,
	39	gfc_array_i4 * const restrict,
	40	shape_type * const restrict);
7f68c75f	41	export_proto(reshape_4);
7d7b8bfe	42
6de9cd9a	43	void
64acfd99 JB	44	reshape_4 (gfc_array_i4 * const restrict ret,
	45	gfc_array_i4 * const restrict source,
	46	shape_type * const restrict shape,
	47	gfc_array_i4 * const restrict pad,
	48	shape_type * const restrict order)
6de9cd9a DN	49	{
6de9cd9a DN	50	/* r.* indicates the return array. */
5f9bfaf2 TK	51	index_type rcount[GFC_MAX_DIMENSIONS];
	52	index_type rextent[GFC_MAX_DIMENSIONS];
	53	index_type rstride[GFC_MAX_DIMENSIONS];
6de9cd9a DN	54	index_type rstride0;
	55	index_type rdim;
	56	index_type rsize;
da8f3dcc TK	57	index_type rs;
da8f3dcc TK	58	index_type rex;
6de9cd9a DN	59	GFC_INTEGER_4 *rptr;
6de9cd9a DN	60	/* s.* indicates the source array. */
5f9bfaf2 TK	61	index_type scount[GFC_MAX_DIMENSIONS];
	62	index_type sextent[GFC_MAX_DIMENSIONS];
	63	index_type sstride[GFC_MAX_DIMENSIONS];
6de9cd9a DN	64	index_type sstride0;
	65	index_type sdim;
	66	index_type ssize;
	67	const GFC_INTEGER_4 *sptr;
	68	/* p.* indicates the pad array. */
5f9bfaf2 TK	69	index_type pcount[GFC_MAX_DIMENSIONS];
	70	index_type pextent[GFC_MAX_DIMENSIONS];
	71	index_type pstride[GFC_MAX_DIMENSIONS];
6de9cd9a DN	72	index_type pdim;
	73	index_type psize;
	74	const GFC_INTEGER_4 *pptr;
	75
	76	const GFC_INTEGER_4 *src;
	77	int n;
	78	int dim;
8c154b65 TK	79	int sempty, pempty, shape_empty;
	80	index_type shape_data[GFC_MAX_DIMENSIONS];
	81
dfb55fdc	82	rdim = GFC_DESCRIPTOR_EXTENT(shape,0);
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
	88	for (n = 0; n < rdim; n++)
	89	{
21d1335b	90	shape_data[n] = shape->base_addr[n * GFC_DESCRIPTOR_STRIDE(shape,0)];
8c154b65	91	if (shape_data[n] <= 0)
e94471ba TK	92	{
	93	shape_data[n] = 0;
	94	shape_empty = 1;
	95	}
8c154b65	96	}
6de9cd9a	97
21d1335b	98	if (ret->base_addr == NULL)
da8f3dcc	99	{
19b76346 TK	100	index_type alloc_size;
19b76346 TK	101
da8f3dcc	102	rs = 1;
47c07d96	103	for (n = 0; n < rdim; n++)
da8f3dcc	104	{
8c154b65	105	rex = shape_data[n];
dfb55fdc TK	106
	107	GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs);
	108
da8f3dcc TK	109	rs *= rex;
da8f3dcc 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_INTEGER_4));
da8f3dcc TK	119	ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) \| rdim;
da8f3dcc TK	120	}
8c154b65 TK	121
	122	if (shape_empty)
	123	return;
da8f3dcc	124
bd72cbc8 TK	125	if (pad)
	126	{
	127	pdim = GFC_DESCRIPTOR_RANK (pad);
	128	psize = 1;
	129	pempty = 0;
	130	for (n = 0; n < pdim; n++)
	131	{
	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;
	161	for (n = 0; n < rdim; n++)
	162	{
	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;
	173	sdim = GFC_DESCRIPTOR_RANK (source);
	174	for (n = 0; n < sdim; n++)
	175	{
	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
	191	for (n = 0; n < rdim; n++)
	192	seen[n] = 0;
	193
	194	for (n = 0; n < rdim; n++)
	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
6de9cd9a DN	211	rsize = 1;
	212	for (n = 0; n < rdim; n++)
	213	{
	214	if (order)
21d1335b	215	dim = order->base_addr[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1;
6de9cd9a DN	216	else
	217	dim = n;
	218
	219	rcount[n] = 0;
dfb55fdc TK	220	rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
dfb55fdc TK	221	rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim);
8c154b65	222	if (rextent[n] < 0)
e94471ba	223	rextent[n] = 0;
6de9cd9a	224
8c154b65	225	if (rextent[n] != shape_data[dim])
6de9cd9a DN	226	runtime_error ("shape and target do not conform");
	227
	228	if (rsize == rstride[n])
	229	rsize *= rextent[n];
	230	else
	231	rsize = 0;
da8f3dcc	232	if (rextent[n] <= 0)
6de9cd9a DN	233	return;
	234	}
	235
	236	sdim = GFC_DESCRIPTOR_RANK (source);
	237	ssize = 1;
47c07d96	238	sempty = 0;
6de9cd9a DN	239	for (n = 0; n < sdim; n++)
	240	{
	241	scount[n] = 0;
dfb55fdc TK	242	sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
dfb55fdc TK	243	sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
6de9cd9a	244	if (sextent[n] <= 0)
47c07d96 FXC	245	{
	246	sempty = 1;
	247	sextent[n] = 0;
	248	}
6de9cd9a DN	249
	250	if (ssize == sstride[n])
	251	ssize *= sextent[n];
	252	else
	253	ssize = 0;
	254	}
	255
6de9cd9a DN	256	if (rsize != 0 && ssize != 0 && psize != 0)
6de9cd9a DN	257	{
92f5e87c TK	258	rsize *= sizeof (GFC_INTEGER_4);
	259	ssize *= sizeof (GFC_INTEGER_4);
	260	psize *= sizeof (GFC_INTEGER_4);
21d1335b TB	261	reshape_packed ((char )ret->base_addr, rsize, (char )source->base_addr,
21d1335b TB	262	ssize, pad ? (char *)pad->base_addr : NULL, psize);
6de9cd9a DN	263	return;
6de9cd9a DN	264	}
21d1335b TB	265	rptr = ret->base_addr;
21d1335b TB	266	src = sptr = source->base_addr;
6de9cd9a DN	267	rstride0 = rstride[0];
	268	sstride0 = sstride[0];
	269
47c07d96 FXC	270	if (sempty && pempty)
	271	abort ();
	272
	273	if (sempty)
	274	{
042fed79	275	/* Pretend we are using the pad array the first time around, too. */
47c07d96	276	src = pptr;
042fed79	277	sptr = pptr;
47c07d96 FXC	278	sdim = pdim;
	279	for (dim = 0; dim < pdim; dim++)
	280	{
	281	scount[dim] = pcount[dim];
	282	sextent[dim] = pextent[dim];
	283	sstride[dim] = pstride[dim];
042fed79	284	sstride0 = pstride[0];
47c07d96 FXC	285	}
	286	}
	287
6de9cd9a DN	288	while (rptr)
	289	{
	290	/* Select between the source and pad arrays. */
	291	rptr = src;
	292	/* Advance to the next element. */
	293	rptr += rstride0;
	294	src += sstride0;
	295	rcount[0]++;
	296	scount[0]++;
47c07d96	297
6de9cd9a DN	298	/* Advance to the next destination element. */
	299	n = 0;
	300	while (rcount[n] == rextent[n])
	301	{
	302	/* When we get to the end of a dimension, reset it and increment
	303	the next dimension. */
	304	rcount[n] = 0;
	305	/* We could precalculate these products, but this is a less
5d7adf7a	306	frequently used path so probably not worth it. */
6de9cd9a DN	307	rptr -= rstride[n] * rextent[n];
	308	n++;
	309	if (n == rdim)
	310	{
	311	/* Break out of the loop. */
	312	rptr = NULL;
	313	break;
	314	}
	315	else
	316	{
	317	rcount[n]++;
	318	rptr += rstride[n];
	319	}
	320	}
	321	/* Advance to the next source element. */
	322	n = 0;
	323	while (scount[n] == sextent[n])
	324	{
	325	/* When we get to the end of a dimension, reset it and increment
	326	the next dimension. */
	327	scount[n] = 0;
	328	/* We could precalculate these products, but this is a less
5d7adf7a	329	frequently used path so probably not worth it. */
6de9cd9a DN	330	src -= sstride[n] * sextent[n];
	331	n++;
	332	if (n == sdim)
	333	{
	334	if (sptr && pad)
	335	{
	336	/* Switch to the pad array. */
	337	sptr = NULL;
	338	sdim = pdim;
	339	for (dim = 0; dim < pdim; dim++)
	340	{
	341	scount[dim] = pcount[dim];
	342	sextent[dim] = pextent[dim];
	343	sstride[dim] = pstride[dim];
	344	sstride0 = sstride[0];
	345	}
	346	}
	347	/* We now start again from the beginning of the pad array. */
	348	src = pptr;
	349	break;
	350	}
	351	else
	352	{
	353	scount[n]++;
	354	src += sstride[n];
	355	}
	356	}
	357	}
	358	}
644cb69f FXC	359
644cb69f FXC	360	#endif