void index1(int i, int f)
{
struct item* p;
int j, k;
if (i >= idx.rank) {
switch (f) {
case 0:
p = sp[-2];
p->index = access();
putdat(sp[-1], getdat(p));
return;
case 1:
datum = getdat(sp[-idx.rank - 3]);
case 2:
p = ((SymTabEntry*)sp[-2])->itemp;
p->index = access();
putdat(p, datum);
return;
}
}
p = sp[-i - 3];
if (p->itemType == EL) {
for (j = 0; j < idx.dim[i]; j++) {
idx.idx[i] = j;
index1(i + 1, f);
}
return;
}
p->index = 0;
for (j = 0; j < p->size; j++) {
k = fix(getdat(p)) - iorigin;
if (k < 0 || k >= idx.dim[i])
error(ERR_index, "");
idx.idx[i] = k;
index1(i + 1, f);
}
}
void com1(int k)
{
struct item* p;
p = sp[-2];
p->index = idx.idx[k];
if (getdat(p)) {
p = sp[-3];
p->index = access();
putdat(sp[-1], getdat(p));
}
}
index1(i, f)
{
struct item *p;
int j, k;
if(i >= idx.rank) {
switch(f) {
case 0:
p = sp[-2];
p->index = access_();
putdat(sp[-1], getdat(p));
return;
case 1:
datum = getdat(sp[-idx.rank-3]);
case 2:
p = ((struct nlist *)sp[-2])->itemp;
p->index = access_();
putdat(p, datum);
return;
}
}
p = sp[-i-3];
if(p->type == EL) {
for(j=0; j<idx.dim[i]; j++) {
idx.idx[i] = j;
index1(i+1, f);
}
return;
}
p->index = 0;
for(j=0; j<p->size; j++) {
k = fix(getdat(p)) - thread.iorg;
if(k < 0 || k >= idx.dim[i]) error("subscript X");
idx.idx[i] = k;
index1(i+1, f);
}
}
void comk(int k)
{
struct item* p;
data d;
int i, dk, ndk;
p = sp[-1];
bidx(sp[-2]);
/* "getdat" returns the value of the data item which
* it is called to fetch. If this is non-zero, just
* use the existing data on the stack (an example in
* APL would be "x/y" where x != 0. If this is zero,
* the result is the null item, which is created by
* "newdat" and pushed on the stack.
*/
if (p->rank == 0 || (p->rank == 1 && p->size == 1)) {
if (getdat(p)) {
pop();
return;
}
p = newdat(idx.type, 1, 0);
pop();
pop();
*sp++ = p;
return;
}
if (idx.rank == 0 && p->rank == 1) {
/* then scalar right arg ok */
dk = p->dim[0];
ndk = 0;
for (i = 0; i < dk; i++) {
if (getdat(p))
ndk++;
}
p = newdat(idx.type, 1, ndk);
d = getdat(sp[-2]);
for (i = 0; i < ndk; i++)
putdat(p, d);
pop();
pop();
*sp++ = p;
return;
}
if (k < 0 || k >= idx.rank)
error(ERR_index, "");
dk = idx.dim[k];
if (p->rank != 1 || p->size != dk)
error(ERR_length, "");
ndk = 0;
for (i = 0; i < dk; i++) {
if (getdat(p))
ndk++;
}
p = newdat(idx.type, idx.rank, (idx.size / dk) * ndk);
copy(IN, (char*)idx.dim, (char*)p->dim, idx.rank);
p->dim[k] = ndk;
*sp++ = p;
indexIterateInit(&idx);
while (indexIterate(&idx)) {
com1(k);
}
sp--;
pop();
pop();
*sp++ = p;
}
