#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include "libgfortran.h"
void
__spread (const gfc_array_char * ret, const gfc_array_char * source,
const index_type * along, const index_type * pncopies)
{
index_type rstride[GFC_MAX_DIMENSIONS - 1];
index_type rstride0;
index_type rdelta;
char *rptr;
char *dest;
index_type sstride[GFC_MAX_DIMENSIONS - 1];
index_type sstride0;
const char *sptr;
index_type count[GFC_MAX_DIMENSIONS - 1];
index_type extent[GFC_MAX_DIMENSIONS - 1];
index_type n;
index_type dim;
index_type size;
index_type ncopies;
size = GFC_DESCRIPTOR_SIZE (source);
dim = 0;
for (n = 0; n < GFC_DESCRIPTOR_RANK (ret); n++)
{
if (n == *along - 1)
{
rdelta = ret->dim[n].stride * size;
}
else
{
count[dim] = 0;
extent[dim] = source->dim[dim].ubound + 1 - source->dim[dim].lbound;
sstride[dim] = source->dim[dim].stride * size;
rstride[dim] = ret->dim[n].stride * size;
dim++;
}
}
dim = GFC_DESCRIPTOR_RANK (source);
if (sstride[0] == 0)
sstride[0] = size;
if (rstride[0] == 0)
rstride[0] = size;
sstride0 = sstride[0];
rstride0 = rstride[0];
rptr = ret->data;
sptr = source->data;
ncopies = *pncopies;
while (sptr)
{
dest = rptr;
for (n = 0; n < ncopies; n++)
{
memcpy (dest, sptr, size);
dest += rdelta;
}
sptr += sstride0;
rptr += rstride0;
count[0]++;
n = 0;
while (count[n] == extent[n])
{
count[n] = 0;
sptr -= sstride[n] * extent[n];
rptr -= rstride[n] * extent[n];
n++;
if (n >= dim)
{
sptr = NULL;
break;
}
else
{
count[n]++;
sptr += sstride[n];
rptr += rstride[n];
}
}
}
}