#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include "libgfortran.h"
extern void *internal_pack (gfc_array_char *);
export_proto(internal_pack);
void *
internal_pack (gfc_array_char * source)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type stride[GFC_MAX_DIMENSIONS];
index_type stride0;
index_type dim;
index_type ssize;
const char *src;
char *dest;
void *destptr;
int n;
int packed;
index_type size;
int type;
if (source->dim[0].stride == 0)
{
source->dim[0].stride = 1;
return source->data;
}
type = GFC_DESCRIPTOR_TYPE (source);
size = GFC_DESCRIPTOR_SIZE (source);
switch (type)
{
case GFC_DTYPE_INTEGER:
case GFC_DTYPE_LOGICAL:
case GFC_DTYPE_REAL:
switch (size)
{
case 4:
return internal_pack_4 ((gfc_array_i4 *)source);
case 8:
return internal_pack_8 ((gfc_array_i8 *)source);
}
break;
case GFC_DTYPE_COMPLEX:
switch (size)
{
case 8:
return internal_pack_c4 ((gfc_array_c4 *)source);
case 16:
return internal_pack_c8 ((gfc_array_c8 *)source);
}
break;
default:
break;
}
dim = GFC_DESCRIPTOR_RANK (source);
ssize = 1;
packed = 1;
for (n = 0; n < dim; n++)
{
count[n] = 0;
stride[n] = source->dim[n].stride;
extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
if (extent[n] <= 0)
{
packed = 1;
break;
}
if (ssize != stride[n])
packed = 0;
ssize *= extent[n];
}
if (packed)
return source->data;
destptr = internal_malloc_size (ssize * size);
dest = (char *)destptr;
src = source->data;
stride0 = stride[0] * size;
while (src)
{
memcpy(dest, src, size);
dest += size;
src += stride0;
count[0]++;
n = 0;
while (count[n] == extent[n])
{
count[n] = 0;
src -= stride[n] * extent[n] * size;
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n] * size;
}
}
}
return destptr;
}