/* array.c -- runtime support of arrays */
#include "rts.h"
#include <stdarg.h>
static void slices ();
/*
* mpd_init_array (locn, addr, elemsize, initvalue, ndim, lb1, ub1, ...)
* -- initialize an array.
*
* If addr is 0, first allocate it. If addr is -1, obtain from mpd_new().
*
* If elemsize is zero or negative, it is the (negative) maxlength of
* a string, for which an initializer will be created internally.
*
* If ndim is negative, it is followed by two *pointers* to lb/ub arrays,
* instead of a list of lb and ub values.
*/
Array *
mpd_init_array (
char *locn, Array *addr, int elemsize, Ptr initvalue, int ndim, ...)
{
va_list ap;
int alcsize, i, n;
Dim *d;
Ptr p, q;
int *lb, *ub, la[MAX_DIMENS], ua[MAX_DIMENS], size[MAX_DIMENS+1];
String s; /* for string initialization */
mpd_check_stk (CUR_STACK);
/*
* Calculate the size of each dimension.
*/
va_start (ap, ndim);
if (ndim < 0) {
ndim = -ndim;
lb = va_arg (ap, int *);
ub = va_arg (ap, int *);
} else {
lb = la;
ub = ua;
for (i = 0; i < ndim; i++) {
lb[i] = va_arg (ap, int);
ub[i] = va_arg (ap, int);
if (ub[i] - lb[i] + 1 < 0)
mpd_runerr (locn, E_ABND, lb[i], ub[i]);
}
}
va_end (ap);
DEBUG5 (D_ARRAY, "mpd_init_array (%06lX, %ld, %06lX, %ld, ?, %ld, ...)",
addr, elemsize, initvalue, ndim, ub[0]);
/*
* Create a string initializer, if needed.
*/
if (elemsize <= 0) {
s.size = -elemsize + STRING_OVH;
s.length = -1;
elemsize = MPDALIGN (s.size);
initvalue = (Ptr) &s;
}
/*
* Calculate the total size, and allocate.
*/
size[ndim] = elemsize;
for (i = ndim - 1; i >= 0; i--)
size[i] = (ub[i] - lb[i] + 1) * size[i+1];
alcsize = MPDALIGN (size[0] + sizeof (Array) + sizeof (Dim) * ndim);
if (addr == NULL)
addr = (Array *) mpd_alc (alcsize, 1);
else if (addr == (Array *) -1)
addr = (Array *) mpd_new (locn, alcsize);
/*
* Initialize array headers.
*/
addr->offset = sizeof (Array) + ndim * sizeof (Dim);
addr->size = addr->offset + size[0];
addr->ndim = ndim;
/*
* Initialize dimension headers (in reverse order)
*/
for (i = ndim - 1, d = (Dim *)(addr + 1); i >= 0; i--, d++) {
d->lb = lb[i];
d->ub = ub[i];
d->stride = size[i+1];
}
/*
* Initialize data
*/
if (initvalue != NULL && size[0] > 0) {
p = ADATA (addr); /* destination */
q = p + size[0]; /* end */
memcpy (p, initvalue, elemsize); /* init first element */
initvalue = p; /* now copy from front of array */
p += elemsize; /* bump store pointer */
n = elemsize; /* bytes available to copy */
while (p + n < q) {
memcpy (p, initvalue, n);
p += n;
n *= 2;
}
memcpy (p, initvalue, q - p);
}
return addr;
}
/*
* Return the number of elements in an array.
*/
int
mpd_acount (a)
Array *a;
{
Dim *d = (Dim *) (a + 1);
int i = a->ndim;
int n = 1;
while (i-- > 0) {
n *= d->ub - d->lb + 1;
d++;
}
return n;
}
/*
* Copy one array to another, returning the pointer to the destination array.
* Data is copied but the destination header is left alone.
*/
Array *
mpd_acopy (locn, dest, src)
char *locn;
Array *dest, *src;
{
Dim *ld, *rd;
int i, ndim;
ndim = dest->ndim;
ld = (Dim *) (dest + 1) + ndim - 1;
rd = (Dim *) (src + 1) + ndim - 1;
for (i = 0; i < ndim; i++, ld--, rd--)
if (ld->ub - ld->lb != rd->ub - rd->lb)
mpd_runerr (locn, E_ASIZ, ld, rd);
memcpy ((Ptr) dest + dest->offset, (Ptr) src + src->offset,
dest->size - dest->offset);
return dest;
}
/*
* Swap two arrays and return the address of the left side (value of R side).
*/
Array *
mpd_aswap (locn, lside, rside)
char *locn;
Array *lside, *rside;
{
Dim *ld, *rd;
Ptr l, r;
char c;
int i, n, ndim;
ndim = lside->ndim;
ld = (Dim *) (lside + 1) + ndim - 1;
rd = (Dim *) (rside + 1) + ndim - 1;
for (i = 0; i < ndim; i++, ld--, rd--)
if (ld->ub - ld->lb != rd->ub - rd->lb)
mpd_runerr (locn, E_ASIZ, ld, rd);
l = ADATA (lside); /* addrs of l and r data */
r = ADATA (rside);
n = lside->size - lside->offset; /* number of bytes to swap */
while (--n >= 0) { /* swap contents */
c = *l;
*l++ = *r;
*r++ = c;
}
return lside; /* return left side address */
}
/*
* Implement a clone operation by making duplicates beyond
* the first and incrementing the store address.
*/
Ptr
mpd_clone (locn, addr, len, n)
char *locn;
Ptr addr;
int len, n;
{
Ptr new = addr;
if (n < 0)
mpd_runerr (locn, E_AREP, n);
if (n == 0)
return new;
while (--n > 0)
memcpy (new += len, addr, len);
return new + len;
}
/*
* mpd_slice (locn, a1, a2, elemsize, nbounds, lb1, ub1, ...)
*
* Extract or store into an array slice, handling multidimensional slicing.
* If a1 is zero, allocate and return a slice of a2.
* If a1 is nonzero, scatter a1 into a slice of a2.
*
* a1 is always the contiguous array; a2 is always the sliced array.
* nbounds is the number of (lb,ub) index pairs that follow.
* A ub value of SINGLEINDEX indicates a singly-indexed dimension of a2 only.
*
* Build an array of "slcinfo" structs and then call slices() to do the
* actual work; it recurses to handle multiple dimensions.
*/
struct slcinfo {
int n; /* number of elements in this dimension */
int d1; /* address incr in contigouous array (0 in last dim) */
int d2; /* address incr in array being sliced */
};
Ptr
mpd_slice (char *locn, Array *a1, Array *a2, int elemsize, int nbounds, ...)
{
va_list ap;
int adim, lb[MAX_DIMENS], ub[MAX_DIMENS]; /* array dims*/
int nelem, telem, offset, scatter;
int i, j, k, l, u, z, o;
struct slcinfo s[MAX_DIMENS+1];
mpd_check_stk (CUR_STACK);
/* get fixed arguments */
va_start (ap, nbounds);
if (elemsize == 0)
elemsize = STRIDE (a2, 0);
/* get index arguments */
telem = 1; /* total element count */
adim = 0; /* dimensionality of a1 */
offset = 0; /* offset into a2 */
for (i = 0; i < nbounds; i++) { /* for each dimension of a2 */
j = a2->ndim - i - 1;
l = va_arg (ap, int); /* get index bounds */
u = va_arg (ap, int);
if (l == ASTERISK) /* translate '*' into actual value */
l = LB (a2, j);
if (u == ASTERISK)
u = UB (a2, j);
o = l - LB (a2, j); /* get a zero-based index */
z = STRIDE (a2, j); /* element size of this dimension */
offset += z * o; /* adjust offset to first element */
if (u == SINGLEINDEX) {
if (o < 0 || l > UB (a2, j))
mpd_runerr (locn, E_ASUB, l, & ADIM (a2, j));
} else {
/* this dimension is truly sliced */
nelem = u - l + 1; /* number of slice elements */
telem *= nelem; /* calc total elements */
if (o < 0 || nelem < 0 || u > UB (a2, j))
mpd_runerr (locn, E_ASLC, l, u, & ADIM (a2, j));
if (a1 != NULL) {
k = a1->ndim - adim - 1;
if (UB (a1, k) - LB (a1, k) + 1 != nelem)
mpd_runerr (locn, E_ACHG, l, u, & ADIM (a1, k));
}
lb[adim] = 1; /* save bounds for a1 */
ub[adim] = u - l + 1;
s[adim].n = nelem;
s[adim].d2 = z; /* size of element in a2 */
adim++; /* count the dimensions */
}
}
va_end (ap);
/* if loading into new array, need to allocate it */
scatter = (a1 != NULL);
if (!scatter)
a1 = mpd_init_array (locn, (Array*)0, elemsize, (Ptr)0, -adim, lb, ub);
for (i = 0; i < adim; i++) /* calculate step sizes for a1 */
s[i].d1 = STRIDE (a1, adim - i - 1);
if (telem > 0) /* if no zero dimensions, copy elems */
slices (adim, ADATA (a1), ADATA (a2) + offset, s, scatter);
return (Ptr) a1; /* always return contiguous array */
}
/*
* slices (lv, p1, p2, s, scatter) -- copy slice data
*
* lv is the number of nesting levels
* p1, p2 are data pointers
* s is array of slice info (see above)
* scatter indicates direction of copy (nonzero for p1->p2)
*
* Copy s->n slice elements, recursing as needed for deeper levels.
*/
static void
slices (lv, p1, p2, s, scatter)
int lv;
Ptr p1, p2;
struct slcinfo *s;
int scatter;
{
int n, d1, d2;
n = s->n;
d1 = s->d1;
d2 = s->d2;
while (--n >= 0) {
if (lv > 1)
slices (lv - 1, p1, p2, s + 1, scatter);
else {
if (scatter)
memcpy (p2, p1, d1);
else
memcpy (p1, p2, d1);
}
p1 += d1;
p2 += d2;
}
}
/*
* Copy an array of strings, elementwise if necessary, into a slice
* (or the whole thing) of another string array. The maxlengths of
* the strings in the two arrays may differ.
*/
Array *
mpd_strarr (locn, dest, lb, ub, src)
char *locn;
Array *dest;
int lb, ub;
Array *src;
{
int ndst, nsrc, i, nelem, maxl;
String *pdst, *psrc;
if (lb == ASTERISK)
lb = LB (dest, 0);
if (ub == ASTERISK)
ub = UB (dest, 0);
nelem = ub - lb + 1;
if (nelem < 0 || lb < LB (dest, 0) || ub > UB (dest, 0))
mpd_runerr (locn, E_ASLC, lb, ub, dest);
if (UB (src, 0) - LB (src, 0) + 1 != nelem)
mpd_runerr (locn, E_ACHG, lb, ub, src);
if (nelem == 0)
return dest; /* empty arrays */
psrc = (String *) ADATA (src); /* pointer to source element */
pdst = (String *) ADATA (dest); /* pointer to dest element */
nsrc = MPDALIGN (psrc->size); /* distance between source elements */
ndst = MPDALIGN (pdst->size); /* distance between dest elements */
pdst = (String *) ((Ptr) pdst + (lb - LB (dest, 0)) * ndst);
/* pointer to first destination strg */
if (psrc->size == pdst->size) { /* if maxlengths are the same */
/* block copy */
memcpy ((Ptr) pdst, (Ptr) psrc, nelem * ndst);
} else {
/* elementwise assignment */
maxl = MAXLENGTH (pdst); /* maxlength of dest element */
for (i = 0; i < nelem; i++) {
if (psrc->length > maxl)
mpd_runerr (locn, E_SELM, LB (src, 0) + i, psrc->length, maxl);
memcpy (DATA (pdst), DATA (psrc), (pdst->length = psrc->length));
pdst = (String *) ((Ptr) pdst + ndst);
psrc = (String *) ((Ptr) psrc + nsrc);
}
}
return dest;
}
/*
* Allocate and initialize a string as a copy of a char array.
*/
Ptr
mpd_astring (a)
Array *a;
{
String *s;
int n;
n = UB (a, 0) - LB (a, 0) + 1;
s = (String *) mpd_alc (n + STRING_OVH, 1);
s->size = n + STRING_OVH;
s->length = n;
memcpy (DATA (s), ADATA (a), n);
return (Ptr) s;
}
/*
* Allocate and extract a string slice.
*/
Ptr
mpd_sslice (locn, s, index1, index2)
char *locn;
String *s;
int index1, index2;
{
int nchars, nbytes;
String *r;
if (index1 == ASTERISK)
index1 = 1;
if (index2 == ASTERISK)
index2 = s->length;
nchars = index2 - index1 + 1;
if (nchars < 0 || index1 < 1 || index2 > s->length)
mpd_runerr (locn, E_SSLC, index1, index2, s, s);
nbytes = nchars + STRING_OVH;
r = (String *) mpd_alc (nbytes, 1);
r->size = nbytes;
r->length = nchars;
memcpy (DATA (r), DATA (s) + index1 - 1, nchars);
return (Ptr) r;
}
/*
* Change a string slice.
*/
String *
mpd_chgstr (locn, s, index1, index2, v)
char *locn;
String *s;
int index1, index2;
String *v;
{
int nchars;
if (index1 == ASTERISK)
index1 = 1;
if (index2 == ASTERISK)
index2 = s->length;
nchars = index2 - index1 + 1;
if (nchars < 0 || index1 < 1 || index2 > s->length)
mpd_runerr (locn, E_SSLC, index1, index2, s, s);
if (nchars != v->length)
mpd_runerr (locn, E_SCHG, v, index1, index2);
memcpy (DATA (s) + index1 - 1, DATA (v), nchars);
return v;
}
syntax highlighted by Code2HTML, v. 0.9.1