#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include "libgfortran.h"
extern void spread (gfc_array_char *, const gfc_array_char *,
const index_type *, const index_type *);
export_proto(spread);
void
spread (gfc_array_char *ret, const gfc_array_char *source,
const index_type *along, const index_type *pncopies)
{
index_type rstride[GFC_MAX_DIMENSIONS];
index_type rstride0;
index_type rdelta;
index_type rrank;
index_type rs;
char *rptr;
char *dest;
index_type sstride[GFC_MAX_DIMENSIONS];
index_type sstride0;
index_type srank;
const char *sptr;
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type n;
index_type dim;
index_type size;
index_type ncopies;
srank = GFC_DESCRIPTOR_RANK(source);
rrank = srank + 1;
if (rrank > GFC_MAX_DIMENSIONS)
runtime_error ("return rank too large in spread()");
if (*along > rrank)
runtime_error ("dim outside of rank in spread()");
ncopies = *pncopies;
size = GFC_DESCRIPTOR_SIZE (source);
if (ret->data == NULL)
{
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;
dim = 0;
rs = 1;
for (n = 0; n < rrank; n++)
{
ret->dim[n].stride = rs;
ret->dim[n].lbound = 0;
if (n == *along - 1)
{
ret->dim[n].ubound = ncopies - 1;
rdelta = rs * size;
rs *= ncopies;
}
else
{
count[dim] = 0;
extent[dim] = source->dim[dim].ubound + 1
- source->dim[dim].lbound;
sstride[dim] = source->dim[dim].stride * size;
rstride[dim] = rs * size;
ret->dim[n].ubound = extent[dim]-1;
rs *= extent[dim];
dim++;
}
}
ret->base = 0;
ret->data = internal_malloc_size (rs * size);
}
else
{
dim = 0;
if (GFC_DESCRIPTOR_RANK(ret) != rrank)
runtime_error ("rank mismatch in spread()");
if (ret->dim[0].stride == 0)
ret->dim[0].stride = 1;
for (n = 0; n < rrank; 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++;
}
}
if (sstride[0] == 0)
sstride[0] = size;
}
sstride0 = sstride[0];
rstride0 = rstride[0];
rptr = ret->data;
sptr = source->data;
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 >= srank)
{
sptr = NULL;
break;
}
else
{
count[n]++;
sptr += sstride[n];
rptr += rstride[n];
}
}
}
}