[thirdparty/gcc.git] / libgfortran / m4 / iforeach.m4

dnl Support macro file for intrinsic functions.
dnl Contains the generic sections of the array functions.
dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
dnl Distributed under the GNU GPL with exception.  See COPYING for details.
define(START_FOREACH_FUNCTION,
`
extern void name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
	atype * const restrict array);
export_proto(name`'rtype_qual`_'atype_code);

void
name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
	atype * const restrict array)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  const atype_name *base;
  rtype_name * restrict dest;
  index_type rank;
  index_type n;

  rank = GFC_DESCRIPTOR_RANK (array);
  if (rank <= 0)
    runtime_error ("Rank of array needs to be > 0");

  if (retarray->data == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  int ret_rank;
	  index_type ret_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in u_name intrinsic"
			   " should be 1, is %ld", (long int) ret_rank);

	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
	  if (ret_extent != rank)
	    runtime_error ("Incorrect extent in return value of"
			   " u_name intrnisic: is %ld, should be %ld",
			   (long int) ret_extent, (long int) rank);
	}
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->data;

  /* Initialize the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;
  {
')dnl
define(START_FOREACH_BLOCK,
`  while (base)
    {
      {
        /* Implementation start.  */
')dnl
define(FINISH_FOREACH_FUNCTION,
`        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[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.  */
          base -= sstride[n] * extent[n];
          n++;
          if (n == rank)
            {
              /* Break out of the loop.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
            }
        }
    }
  }
}')dnl
define(START_MASKED_FOREACH_FUNCTION,
`
extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict, 
	atype * const restrict, gfc_array_l1 * const restrict);
export_proto(`m'name`'rtype_qual`_'atype_code);

void
`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
	atype * const restrict array,
	gfc_array_l1 * const restrict mask)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  rtype_name *dest;
  const atype_name *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;

  rank = GFC_DESCRIPTOR_RANK (array);
  if (rank <= 0)
    runtime_error ("Rank of array needs to be > 0");

  if (retarray->data == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  int ret_rank, mask_rank;
	  index_type ret_extent;
	  int n;
	  index_type array_extent, mask_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in u_name intrinsic"
			   " should be 1, is %ld", (long int) ret_rank);

	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
	  if (ret_extent != rank)
	    runtime_error ("Incorrect extent in return value of"
			   " u_name intrnisic: is %ld, should be %ld",
			   (long int) ret_extent, (long int) rank);
	
	  mask_rank = GFC_DESCRIPTOR_RANK (mask);
	  if (rank != mask_rank)
	    runtime_error ("rank of MASK argument in u_name intrnisic"
	                   "should be %ld, is %ld", (long int) rank,
			   (long int) mask_rank);

	  for (n=0; n<rank; n++)
	    {
	      array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
	      mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
	      if (array_extent != mask_extent)
		runtime_error ("Incorrect extent in MASK argument of"
			       " u_name intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) mask_extent, (long int) array_extent);
	    }
	}
    }

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  mbase = mask->data;

  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
      || mask_kind == 16
#endif
      )
    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
  else
    runtime_error ("Funny sized logical array");

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->data;

  /* Initialize the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;
  {
')dnl
define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
define(FINISH_MASKED_FOREACH_FUNCTION,
`        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[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.  */
          base -= sstride[n] * extent[n];
          mbase -= mstride[n] * extent[n];
          n++;
          if (n == rank)
            {
              /* Break out of the loop.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              mbase += mstride[n];
            }
        }
    }
  }
}')dnl
define(FOREACH_FUNCTION,
`START_FOREACH_FUNCTION
$1
START_FOREACH_BLOCK
$2
FINISH_FOREACH_FUNCTION')dnl
define(MASKED_FOREACH_FUNCTION,
`START_MASKED_FOREACH_FUNCTION
$1
START_MASKED_FOREACH_BLOCK
$2
FINISH_MASKED_FOREACH_FUNCTION')dnl
define(SCALAR_FOREACH_FUNCTION,
`
extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, 
	atype * const restrict, GFC_LOGICAL_4 *);
export_proto(`s'name`'rtype_qual`_'atype_code);

void
`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
	atype * const restrict array,
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type dstride;
  index_type n;
  rtype_name *dest;

  if (*mask)
    {
      name`'rtype_qual`_'atype_code (retarray, array);
      return;
    }

  rank = GFC_DESCRIPTOR_RANK (array);

  if (rank <= 0)
    runtime_error ("Rank of array needs to be > 0");

  if (retarray->data == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  int ret_rank;
	  index_type ret_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in u_name intrinsic"
			   " should be 1, is %ld", (long int) ret_rank);

	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
	    if (ret_extent != rank)
	      runtime_error ("dimension of return array incorrect");
	}
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->data;
  for (n = 0; n<rank; n++)
    dest[n * dstride] = $1 ;
}')dnl
Commit	Line	Data
6de9cd9a DN	1	dnl Support macro file for intrinsic functions.
	2	dnl Contains the generic sections of the array functions.
	3	dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
57dea9f6	4	dnl Distributed under the GNU GPL with exception. See COPYING for details.
6de9cd9a	5	define(START_FOREACH_FUNCTION,
7d7b8bfe	6	`
64acfd99 JB	7	extern void name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
64acfd99 JB	8	atype * const restrict array);
7f68c75f	9	export_proto(name`'rtype_qual`_'atype_code);
7d7b8bfe RH	10
7d7b8bfe RH	11	void
64acfd99 JB	12	name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
64acfd99 JB	13	atype * const restrict array)
6de9cd9a DN	14	{
	15	index_type count[GFC_MAX_DIMENSIONS];
	16	index_type extent[GFC_MAX_DIMENSIONS];
	17	index_type sstride[GFC_MAX_DIMENSIONS];
	18	index_type dstride;
64acfd99	19	const atype_name *base;
5863aacf	20	rtype_name * restrict dest;
6de9cd9a DN	21	index_type rank;
	22	index_type n;
	23
	24	rank = GFC_DESCRIPTOR_RANK (array);
50dd63a9 TK	25	if (rank <= 0)
	26	runtime_error ("Rank of array needs to be > 0");
	27
	28	if (retarray->data == NULL)
	29	{
dfb55fdc	30	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
50dd63a9	31	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
efd4dc1a	32	retarray->offset = 0;
50dd63a9 TK	33	retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
	34	}
	35	else
	36	{
9731c4a3	37	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	38	{
	39	int ret_rank;
	40	index_type ret_extent;
	41
	42	ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	43	if (ret_rank != 1)
	44	runtime_error ("rank of return array in u_name intrinsic"
ccacefc7	45	" should be 1, is %ld", (long int) ret_rank);
50dd63a9	46
dfb55fdc	47	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
fd6590f8 TK	48	if (ret_extent != rank)
fd6590f8 TK	49	runtime_error ("Incorrect extent in return value of"
ccacefc7 TK	50	" u_name intrnisic: is %ld, should be %ld",
ccacefc7 TK	51	(long int) ret_extent, (long int) rank);
fd6590f8	52	}
50dd63a9	53	}
c6abe94d	54
dfb55fdc	55	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
6de9cd9a DN	56	dest = retarray->data;
	57	for (n = 0; n < rank; n++)
	58	{
dfb55fdc TK	59	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	60	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
6de9cd9a DN	61	count[n] = 0;
	62	if (extent[n] <= 0)
	63	{
	64	/* Set the return value. */
	65	for (n = 0; n < rank; n++)
	66	dest[n * dstride] = 0;
	67	return;
	68	}
	69	}
	70
	71	base = array->data;
	72
	73	/* Initialize the return value. */
	74	for (n = 0; n < rank; n++)
a4b9e93e	75	dest[n * dstride] = 0;
6de9cd9a DN	76	{
	77	')dnl
	78	define(START_FOREACH_BLOCK,
	79	` while (base)
	80	{
	81	{
	82	/* Implementation start. */
	83	')dnl
	84	define(FINISH_FOREACH_FUNCTION,
	85	` /* Implementation end. */
	86	}
	87	/* Advance to the next element. */
	88	count[0]++;
	89	base += sstride[0];
	90	n = 0;
	91	while (count[n] == extent[n])
	92	{
	93	/* When we get to the end of a dimension, reset it and increment
	94	the next dimension. */
	95	count[n] = 0;
	96	/* We could precalculate these products, but this is a less
8b6dba81	97	frequently used path so probably not worth it. */
6de9cd9a DN	98	base -= sstride[n] * extent[n];
	99	n++;
	100	if (n == rank)
	101	{
	102	/* Break out of the loop. */
	103	base = NULL;
	104	break;
	105	}
	106	else
	107	{
	108	count[n]++;
	109	base += sstride[n];
	110	}
	111	}
	112	}
	113	}
	114	}')dnl
	115	define(START_MASKED_FOREACH_FUNCTION,
7d7b8bfe	116	`
64acfd99	117	extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict,
28dc6b33	118	atype * const restrict, gfc_array_l1 * const restrict);
7f68c75f	119	export_proto(`m'name`'rtype_qual`_'atype_code);
7d7b8bfe RH	120
7d7b8bfe RH	121	void
64acfd99 JB	122	`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
64acfd99 JB	123	atype * const restrict array,
28dc6b33	124	gfc_array_l1 * const restrict mask)
6de9cd9a DN	125	{
	126	index_type count[GFC_MAX_DIMENSIONS];
	127	index_type extent[GFC_MAX_DIMENSIONS];
	128	index_type sstride[GFC_MAX_DIMENSIONS];
	129	index_type mstride[GFC_MAX_DIMENSIONS];
	130	index_type dstride;
	131	rtype_name *dest;
64acfd99	132	const atype_name *base;
28dc6b33	133	GFC_LOGICAL_1 *mbase;
6de9cd9a DN	134	int rank;
6de9cd9a DN	135	index_type n;
28dc6b33	136	int mask_kind;
6de9cd9a DN	137
6de9cd9a DN	138	rank = GFC_DESCRIPTOR_RANK (array);
50dd63a9 TK	139	if (rank <= 0)
	140	runtime_error ("Rank of array needs to be > 0");
	141
	142	if (retarray->data == NULL)
	143	{
dfb55fdc	144	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
50dd63a9	145	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
efd4dc1a	146	retarray->offset = 0;
50dd63a9 TK	147	retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
	148	}
	149	else
	150	{
9731c4a3	151	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	152	{
	153	int ret_rank, mask_rank;
	154	index_type ret_extent;
	155	int n;
	156	index_type array_extent, mask_extent;
	157
	158	ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	159	if (ret_rank != 1)
	160	runtime_error ("rank of return array in u_name intrinsic"
ccacefc7	161	" should be 1, is %ld", (long int) ret_rank);
50dd63a9	162
dfb55fdc	163	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
fd6590f8 TK	164	if (ret_extent != rank)
fd6590f8 TK	165	runtime_error ("Incorrect extent in return value of"
ccacefc7 TK	166	" u_name intrnisic: is %ld, should be %ld",
ccacefc7 TK	167	(long int) ret_extent, (long int) rank);
fd6590f8 TK	168
	169	mask_rank = GFC_DESCRIPTOR_RANK (mask);
	170	if (rank != mask_rank)
	171	runtime_error ("rank of MASK argument in u_name intrnisic"
ccacefc7 TK	172	"should be %ld, is %ld", (long int) rank,
ccacefc7 TK	173	(long int) mask_rank);
fd6590f8 TK	174
	175	for (n=0; n<rank; n++)
	176	{
dfb55fdc TK	177	array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
dfb55fdc TK	178	mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
fd6590f8 TK	179	if (array_extent != mask_extent)
fd6590f8 TK	180	runtime_error ("Incorrect extent in MASK argument of"
ccacefc7 TK	181	" u_name intrinsic in dimension %ld:"
ccacefc7 TK	182	" is %ld, should be %ld", (long int) n + 1,
fd6590f8 TK	183	(long int) mask_extent, (long int) array_extent);
	184	}
	185	}
50dd63a9	186	}
6de9cd9a	187
28dc6b33 TK	188	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	189
	190	mbase = mask->data;
	191
	192	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	193	#ifdef HAVE_GFC_LOGICAL_16
	194	\|\| mask_kind == 16
	195	#endif
	196	)
	197	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	198	else
	199	runtime_error ("Funny sized logical array");
	200
dfb55fdc	201	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
6de9cd9a DN	202	dest = retarray->data;
	203	for (n = 0; n < rank; n++)
	204	{
dfb55fdc TK	205	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	206	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	207	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
6de9cd9a DN	208	count[n] = 0;
	209	if (extent[n] <= 0)
	210	{
	211	/* Set the return value. */
	212	for (n = 0; n < rank; n++)
	213	dest[n * dstride] = 0;
	214	return;
	215	}
	216	}
	217
	218	base = array->data;
6de9cd9a DN	219
	220	/* Initialize the return value. */
	221	for (n = 0; n < rank; n++)
a4b9e93e	222	dest[n * dstride] = 0;
6de9cd9a DN	223	{
	224	')dnl
	225	define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
	226	define(FINISH_MASKED_FOREACH_FUNCTION,
	227	` /* Implementation end. */
	228	}
	229	/* Advance to the next element. */
	230	count[0]++;
	231	base += sstride[0];
	232	mbase += mstride[0];
	233	n = 0;
	234	while (count[n] == extent[n])
	235	{
	236	/* When we get to the end of a dimension, reset it and increment
	237	the next dimension. */
	238	count[n] = 0;
	239	/* We could precalculate these products, but this is a less
8b6dba81	240	frequently used path so probably not worth it. */
6de9cd9a DN	241	base -= sstride[n] * extent[n];
	242	mbase -= mstride[n] * extent[n];
	243	n++;
	244	if (n == rank)
	245	{
	246	/* Break out of the loop. */
	247	base = NULL;
	248	break;
	249	}
	250	else
	251	{
	252	count[n]++;
	253	base += sstride[n];
	254	mbase += mstride[n];
	255	}
	256	}
	257	}
	258	}
	259	}')dnl
	260	define(FOREACH_FUNCTION,
	261	`START_FOREACH_FUNCTION
	262	$1
	263	START_FOREACH_BLOCK
	264	$2
	265	FINISH_FOREACH_FUNCTION')dnl
	266	define(MASKED_FOREACH_FUNCTION,
	267	`START_MASKED_FOREACH_FUNCTION
	268	$1
	269	START_MASKED_FOREACH_BLOCK
	270	$2
	271	FINISH_MASKED_FOREACH_FUNCTION')dnl
97a62038 TK	272	define(SCALAR_FOREACH_FUNCTION,
	273	`
	274	extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict,
	275	atype * const restrict, GFC_LOGICAL_4 *);
	276	export_proto(`s'name`'rtype_qual`_'atype_code);
	277
	278	void
	279	`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
	280	atype * const restrict array,
	281	GFC_LOGICAL_4 * mask)
	282	{
	283	index_type rank;
	284	index_type dstride;
	285	index_type n;
	286	rtype_name *dest;
	287
	288	if (*mask)
	289	{
	290	name`'rtype_qual`_'atype_code (retarray, array);
	291	return;
	292	}
	293
	294	rank = GFC_DESCRIPTOR_RANK (array);
	295
	296	if (rank <= 0)
	297	runtime_error ("Rank of array needs to be > 0");
	298
	299	if (retarray->data == NULL)
	300	{
dfb55fdc	301	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
97a62038 TK	302	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	303	retarray->offset = 0;
	304	retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
	305	}
	306	else
	307	{
9731c4a3	308	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	309	{
	310	int ret_rank;
	311	index_type ret_extent;
97a62038	312
fd6590f8 TK	313	ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	314	if (ret_rank != 1)
	315	runtime_error ("rank of return array in u_name intrinsic"
ccacefc7	316	" should be 1, is %ld", (long int) ret_rank);
fd6590f8	317
dfb55fdc	318	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
fd6590f8 TK	319	if (ret_extent != rank)
	320	runtime_error ("dimension of return array incorrect");
	321	}
97a62038 TK	322	}
97a62038 TK	323
dfb55fdc	324	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
97a62038 TK	325	dest = retarray->data;
	326	for (n = 0; n<rank; n++)
	327	dest[n * dstride] = $1 ;
	328	}')dnl